home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / MYPROGS.ZIP / SNAKE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-04-06  |  7KB  |  264 lines
  1. {             VIDAL charles ld 217-18                             }
  2.  
  3.  
  4. program SNAKE_GAME;
  5.  
  6. { the maze is in a text file :  - title.txt     - maze.txt    }
  7.  
  8. uses crt;
  9. const nbl=78;                               { number of line }
  10.       nbc=22;                               { number of column }
  11.       left=':';
  12.       right='!';
  13.       up='d';
  14.       down='c';
  15.  
  16. type MAZE=array[1..nbl,1..nbc] of byte;
  17.      SNAKE=array[1..300] of byte;
  18.  
  19. var x,y,body,i,j,dir,dirx,diry: byte;
  20.                 t: MAZE;
  21.                 a: char;
  22.              test,byebye: boolean;
  23.             tx,ty:SNAKE;
  24.                 f:text;
  25.             line:string;
  26.                name:string;
  27.                 s: integer;
  28.  
  29. PROCEDURE LOAD2;                                { load title  }
  30. BEGIN
  31.   for i:=1 to nbl do
  32.       for j:=1 to nbc do t[i,j]:=0;
  33.    name:='title.pas';
  34.   assign(f,name);
  35.   reset(f);
  36.   i:=0;
  37.   while NOT eof(f) do
  38.       BEGIN
  39.         i:=i+1;
  40.         readln(f,line);
  41.         for j:=1 to length(line) do
  42.                    BEGIN
  43.                      if line[j]=' ' then t[j,i]:=0
  44.                      else
  45.                        t[j,i]:=ord(line[j])-ord('0');
  46.                    END;
  47.       END;
  48.   close(f);
  49. END;
  50.  
  51. PROCEDURE LOAD;                                       { load maze  }
  52. BEGIN
  53.    name:='maze.pas';
  54.   assign(f,name);
  55.   reset(f);
  56.   i:=0;
  57.   while NOT eof(f) do
  58.       BEGIN
  59.         i:=i+1;
  60.         readln(f,line);
  61.         for j:=1 to length(line) do
  62.                    BEGIN
  63.                      if line[j]=' ' then t[j,i]:=0
  64.                      else
  65.                        t[j,i]:=ord(line[j])-ord('0');
  66.                    END;
  67.       END;
  68.   close(f);
  69. END;
  70.  
  71.  
  72. PROCEDURE DISPLAY_MAZE;
  73. BEGIN
  74.  
  75.   for i:=1 to nbl do
  76.   BEGIN
  77.     for j:=1 to nbc do
  78.       BEGIN
  79.         GOTOXY(i,j);
  80.         CASE t[i,j] of
  81.            0: write(' ');                      { empty place  }
  82.            3: BEGIN
  83.                textcolor(2);                   { color:green  }
  84.                write(chr(235));                {   apples     }
  85.                END;
  86.            2:BEGIN
  87.                textcolor(8);                   { color: gray   }
  88.                write(chr(219));                {   walls      }
  89.              END;
  90.            1: BEGIN
  91.                 textcolor(4);                  { color red    }
  92.                 write('@');                    { snake's head }
  93.               END;
  94.         END;
  95.       END;
  96.   END;
  97. END;
  98.  
  99. PROCEDURE DISPLAY_SNAKE;
  100. BEGIN
  101.   gotoxy(2,24);write(body-1);
  102.   gotoxy(tx[body],ty[body]);
  103.   write(' ');                                 { erase then end of then snake}
  104.   gotoxy(tx[1],ty[1]);
  105.   textcolor(4);
  106.   write('@');                                 { display snake's head        }
  107.   gotoxy(tx[2],ty[2]);
  108.   textcolor(4);
  109.   write('0');                                 {display the begining of the }
  110. END;                                          { snake                      }
  111.  
  112. FUNCTION COLLISION(x,y:byte;tx,ty:snake):boolean;
  113. BEGIN
  114.  CASE dir OF
  115.     0: tX[1]:=tX[1]+1;
  116.     1: tY[1]:=tY[1]+1;
  117.     2: tX[1]:=tX[1]-1;
  118.     3: tY[1]:=tY[1]-1;
  119.   END;
  120.  if (t[tx[1],ty[1]]<>0) and (t[tx[1],ty[1]]<>3) then collision:=true
  121.                                    else collision:=false;
  122. END;
  123.  
  124. PROCEDURE MEET(var x,y:byte);
  125. BEGIN
  126.   if dir=3 then dir:=0 else dir:=dir+1;
  127.     if collision(x,y,tx,ty) then
  128.                            BEGIN
  129.                              CASE dir of
  130.                                0: dir:=2;
  131.                                1: dir:=3;
  132.                                2: dir:=0;
  133.                                3: dir:=1;
  134.                              END;
  135.                              if collision(x,y,tx,ty) then test:=false
  136.                                  else BEGIN
  137.                                          x:=tx[1];y:=ty[1];
  138.                                       END;
  139.                            END
  140.   else BEGIN
  141.          x:=tx[1];y:=ty[1];
  142.        END;
  143. END;
  144.  
  145. PROCEDURE DIRECTION(var dir:byte);
  146. var d: byte;
  147. BEGIN
  148.     CASE a OF
  149.       right: d:=0;                               { change direction   }
  150.       left: d:=2;
  151.       up:   d:=3;
  152.       down:    d:=1;
  153.     else d:=dir;
  154.     END;
  155.     if (d<>dir+2) and (d<>dir-2) then dir:=d;
  156. END;
  157.  
  158. PROCEDURE CHANGE_ARRAY(var t: MAZE);
  159. BEGIN
  160.   CASE dir OF
  161.     0: X:=X+1;
  162.     1: Y:=Y+1;
  163.     2: X:=X-1;
  164.     3: Y:=Y-1;
  165.   END;
  166.   if (t[x,y]<>0) and (t[x,y]<>3) then BEGIN
  167.                        MEET(x,y);
  168.                        if not test then
  169.                        BEGIN
  170.                          byebye:=true;                  { you lost   }
  171.                          exit;
  172.                        END;
  173.                     END
  174.      else
  175.  
  176.      if (t[x,y]=3) and (body<300) then BEGIN
  177.                                         body:=body+1;   {body is growing }
  178.                                         s:=0;
  179.                                         repeat
  180.                                          s:=s+1;
  181.                                          sound(s*2+1000);  { goulpssss!!!}
  182.                                         until s=1000;
  183.                                         nosound;
  184.                                         END;
  185.      for i:=body downto 2 do BEGIN
  186.                                 tx[i]:=tx[i-1];
  187.                                 ty[i]:=ty[i-1];
  188.                                END;
  189.       tx[1]:=x;
  190.       ty[1]:=y;
  191.       t[tx[body],ty[body]]:=0;
  192.       t[x,y]:=1;
  193. END;
  194.  
  195. PROCEDURE INTRODUCTION;
  196. BEGIN
  197.   clrscr;                                  { clear screen      }
  198.   LOAD2;
  199.   x:=17;
  200.   y:=12;
  201.   t[x,y]:=1;
  202.   a:=' ';
  203.   dir:=2;
  204.   test:=true;
  205.   body:=4;
  206.   tx[1]:=x;ty[1]:=y;tx[2]:=x;ty[2]:=y-1;tx[3]:=x;ty[3]:=y-2;
  207.   DISPLAY_MAZE;
  208.   gotoxy(25,21);
  209.   write(' PRESS RETURN TO PLAY ');
  210.   gotoxy(18,23);
  211.   write('gauche=: droite=! haut=d bas=c fin=q');
  212.  
  213.   while not  keypressed  do
  214.                BEGIN
  215.                  delay(50);
  216.                  CHANGE_ARRAY(t);
  217.                  DISPLAY_SNAKE;
  218.                END;
  219. END;
  220.  
  221.  
  222. BEGIN                       { program's spine  }
  223.   INTRODUCTION;
  224.   repeat
  225.   byebye:=false;
  226.   clrscr;                    {clear screen }
  227.   LOAD;
  228.   x:=10;
  229.   y:=10;
  230.   t[x,y]:=1;
  231.   a:=' ';
  232.   dir:=2;
  233.   test:=true;
  234.   body:=4;
  235.   tx[1]:=x;ty[1]:=y;tx[2]:=x;ty[2]:=y-1;tx[3]:=x;ty[3]:=y-2;
  236.   DISPLAY_MAZE;
  237.   while (a<>'Q') and (not byebye) do
  238.                  BEGIN
  239.                  CHANGE_ARRAY(t);
  240.                  DISPLAY_SNAKE;
  241.                   i:=1;
  242.                   repeat
  243.                     i:=i+1;
  244.                     j:=1;
  245.                     repeat
  246.                      j:=j+1;
  247.                     if keypressed then
  248.                      BEGIN
  249.                       a:=readkey;
  250.                       DIRECTION(dir);
  251.                       i:=255;
  252.                      END;
  253.                     until (j=10) or (a='Q') or (a='q') or (byebye);
  254.                   until (i=255) or (a='Q') or (a='q') or (byebye);
  255.                END;
  256.   clrscr;
  257.   gotoxy(35,15);
  258.   write('finish Yes or No :');
  259.   a:=readkey;
  260.   write(a);
  261.   until (a='Y') or (a='y');
  262.   readln;
  263. END.
  264.