All pastes #293462 Raw Edit

Untitled

public text v1 · immutable
#293462 ·published 2006-12-27 17:07 UTC
rendered paste body

   PROGRAM Snak;

   USES crt, graph, graph3;

   VAR
     sterownik,tryb:integer;  size:integer;  x,y,xx,yy:integer;  bas,gas:integer;
     point,as,p,dd:integer; z, prev_z:char;  h,hah,prote,wall:boolean;
     snake:array[1..2,0..350] of integer;

   PROCEDURE Body(x,y:integer);
   begin
     putpixel(x+1,y-1,14); putpixel(x+2,y-1,14); putpixel(x+3,y-1,14); putpixel(x,y,14);
     putpixel(x+1,y,1); putpixel(x+2,y,14); putpixel(x+3,y,1); putpixel(x+4,y,14);
     putpixel(x-1,y+1,14); putpixel(x,y+1,14); putpixel(x+1,y+1,1); putpixel(x+2,y+1,14);
     putpixel(x+3,y+1,1); putpixel(x+4,y+1,14); putpixel(x+5,y+1,14); putpixel(x-1,y+2,14); 
     putpixel(x,y+2,14); putpixel(x+1,y+2,14); putpixel(x+2,y+2,14);  putpixel(x+3,y+2,14);
     putpixel(x+4,y+2,14); putpixel(x+5,y+2,14); putpixel(x-1,y+3,14); putpixel(x,y+3,14);
     putpixel(x+1,y+3,14); putpixel(x+2,y+3,14);  putpixel(x+3,y+3,14); putpixel(x+4,y+3,14); 
     putpixel(x+5,y+3,14); putpixel(x-1,y+4,14); putpixel(x,y+4,4); putpixel(x+1,y+4,14);  
     putpixel(x+2,y+4,14); putpixel(x+3,y+4,14); putpixel(x+4,y+4,4); putpixel(x+5,y+4,14);
     putpixel(x,y+5,14); putpixel(x+1,y+5,4); putpixel(x+2,y+5,4); putpixel(x+3,y+5,4);
     putpixel (x+4,y+5,14); putpixel(x+1,y+6,14); putpixel(x+2,y+6,14);  putpixel(x+3,y+6,14);      
   end;

   Procedure protection;
   begin;
     for bas:=0 to point do
      for gas:=0 to point do
       if gas<>bas then
        if (snake[1,bas]=snake[1,gas]) and (snake[2,bas]=snake[2,gas]) then 
         prote:=true;
   end;

   Procedure rewrite;
   begin
     for as:=point downto 1 do
     begin
       snake[1,as]:=snake[1,as-1];
       snake[2,as]:=snake[2,as-1];
     end;
     snake[1,0]:=x;
     snake[2,0]:=y;
   end;

   Procedure rec(x,y:integer);

   begin
      setcolor(1);
      rectangle(x-1,y-1,x+5,y+6);
      rectangle(x,y,x+4,y+5);
      rectangle(x+1,y+1,x+3,y+4);
      rectangle(x+2,y+2,x+2,y+3);
   end;

   Procedure checkin;
   begin
     h:=false;
     if (xx>=x-2) and (xx+1<=x+6) then
       if (yy>=y-2) and (yy+1<=y+7) then
       begin 
         h:=true; point:=point+1; hah:=true;    setcolor(1);
         rectangle(xx,yy,xx+1,yy+1);
         xx:=random(238)+201;
         yy:=random(470)+5;
       end;
   end;

   PROCEDURE Orient;
    begin
    z := chr(0); {w c++ byloby tylko 0 lub poprawniej '\0' ;] }
     repeat
      prev_z := z;
      z:=readkey;
      if (ord(z) = 0) then
         z:= readkey;
      if (((ord(z)=75) and (ord(prev_z) = 77)) or ((ord(z) = 77) and (ord(prev_z)=75)) or ((ord(z)=72)
         and (ord(prev_z) = 80)) or ((ord(z)=80) and (ord(prev_z) = 72))) then
         z:= prev_z;
      case ord(z) of
      72:begin
          repeat
            setcolor(1);   delay(60);
            if hah=true then hah:=false else rec(snake[1,point],snake[2,point]);
            floodfill(x,y-1,1);
            y:=y-8; if y<5 then if dd=2 then y:=469;
            body(x,y); checkin; rewrite; protection;
            setcolor(15);
            rectangle(xx,yy,xx+1,yy+1);
          until (keypressed) or prote or (y<5);
         end;
      80:begin
          repeat
            delay(60);
            setcolor(1);
            if hah=true then hah:=false else rec(snake[1,point],snake[2,point]);
            floodfill(x,y-1,1);
            y:=y+8; if y>469 then if dd=2 then y:=5;
            body(x,y); checkin; rewrite; protection;
            setcolor(15);
            rectangle(xx,yy,xx+1,yy+1);
          until (keypressed) or prote or (y>469);
         end;
      75:begin
          repeat
            delay(60);
            setcolor(1);
            if hah=true then hah:=false else rec(snake[1,point],snake[2,point]);
            floodfill(x,y-1,1);
            x:=x-7; if x<202 then if dd=2then x:=435;
            body(x,y); checkin; rewrite; protection;
            setcolor(15);
            rectangle(xx,yy,xx+1,yy+1);
          until (keypressed) or prote or (x<202);
         end;
      77:begin
          repeat
            delay(60);
            setcolor(1);
            if hah=true then hah:=false else rec(snake[1,point],snake[2,point]);
            floodfill(x,y-1,1);
            x:=x+7; if x>435 then if dd=2 then x:=202;
            body(x,y); checkin ; rewrite; protection;
            setcolor(15);
            rectangle(xx,yy,xx+1,yy+1);
          until (keypressed) or prote or (x>435);
         end;
     end;
     until (x<202) or (x>435) or (y<5) or (y>469) or prote;
   end;


   BEGIN

     clrscr;
     gotoxy(25,5);
     write('SNAKE by AHead 26.12.06');
     gotoxy(19,10);
     write('sterowanie za pomoca strzalek | esc-pauza');
     gotoxy(17,12);
     write('postaraj sie zjesc jak najwiecej bialych kropek');
     gotoxy(22,14);
     write(' oraz nie wjechac w wlasny ogon');  
     gotoxy(10,16);
     write('wybierz tryb: f1-sciany wlaczone  f2-sciany wylaczone');
     dd:=0;
     repeat
       z:=readkey;
       case ord(z) of
       59:dd:=1;
       60:dd:=2;
       end;
     until dd>0;
     sterownik:=detect;
     initgraph(sterownik,tryb,'c:/tp/bgi');
     clrscr;           point:=0;
     setcolor(4);
     rectangle(198,1,443,478);
     rectangle(199,2,442,477);
     rectangle(200,3,441,476);
     setcolor(1);
     rectangle(201,4,440,475);
     setfillstyle(1,1);
     floodfill(219,5,1);
     setfillstyle(1,0);
     floodfill(1,1,4);
     floodfill(500,3,4);
     x:=350; y:=45;    rewrite;
     body(x,Y);
     randomize;
     xx:=random(238)+201;
     yy:=random(472)+4;
     setcolor(15);
     rectangle(xx,yy,xx+1,yy+1);
     orient;
     clrscr;
     closegraph;   clrscr; gotoxy(25,5); if point=1 then write
     ('game over!     1 point') else
     write('game over!     ',point,' points');   delay(2000);

   END.