SaveText.Ru

Без имени
  1. uses crt;
  2. {
  3. управление      w
  4.                                                 a       d
  5.                                                         s
  6. }
  7. const
  8.  
  9.  Wm = 30;
  10.  Hm = 20;
  11. Maxlen = 100;
  12.  snch  = '*';
  13. edach = '%';
  14.  bigedach = 'W';
  15.  stena = '#';
  16.  maxtlifeb = 40;
  17.  var
  18.  Matrix:array [1..Hm]of string= (
  19.          '####                     #####' ,
  20.          '#                            #' ,
  21.          '#                            #' ,
  22.          '#                            #' ,
  23.          '                               ',
  24.          '                              ' ,
  25.          '                              ' ,
  26.          '                              ' ,
  27.          '                              ' ,
  28.          '         #########            ' ,
  29.          '                              ' ,
  30.          '         #########            ' ,
  31.          '                              ' ,
  32.          '                              ' ,
  33.          '                              ' ,
  34.          '                              ' ,
  35.          '#                            #' ,
  36.          '#                            #' ,
  37.          '#                            #' ,
  38.          '####                      ####'
  39. );
  40.  dir:integer=0;
  41.  count:integer = 4;
  42.  tick:integer = 0;
  43.  lifeda:boolean = false;
  44.  tlifedab:integer = 10;
  45.  lifedab:boolean = false;
  46.   GameOver:boolean;
  47.  score:integer = 0;
  48.  randbe:integer;
  49.  
  50.  snake:array [0..Maxlen] of record x,y:integer;end;
  51. procedure onkeyboard();
  52. begin
  53.         if (keypressed)then
  54.         begin
  55.                 case readkey of
  56.                  'a': if (dir <> 2)then dir := 0;
  57.                  'w': if (dir <> 3)then dir := 1;
  58.                  'd': if(dir <> 0)then dir := 2;
  59.                  's': if (dir <> 1)then dir := 3;
  60.                 end;
  61.         end;
  62. end;
  63. procedure snakep();
  64. var i:integer;
  65. begin
  66.         for i := count downto 1 do snake[i] := snake[i - 1];
  67.                
  68.         case (dir) of
  69.          0:begin
  70.                 if (snake[0].x = 1)then snake[0].x := Wm;
  71.                  snake[0].x:=snake[0].x-1;
  72.          end;
  73.          1:begin
  74.                  if (snake[0].y = 1)then  snake[0].y := Hm;
  75.                  snake[0].y:=snake[0].y-1;
  76.          end;
  77.          2: begin
  78.                 if (snake[0].x = Wm)then snake[0].x := 1;
  79.                 snake[0].x:=snake[0].x+1;
  80.          end;
  81.          3:begin
  82.                  if (snake[0].y = Hm)then snake[0].y := 1;  
  83.                  snake[0].y:=snake[0].y+1;
  84.          end;
  85.         end;
  86.         if (Matrix[snake[0].y][snake[0].x] = stena)then
  87.         begin
  88.                 GameOver := true;
  89.         end;
  90.  
  91.         if (Matrix[snake[0].y][snake[0].x] = snch)then
  92.         begin
  93.                 GameOver := true;
  94.         end;
  95.         if (Matrix[snake[0].y][snake[0].x] = edach)then
  96.         begin
  97.                 lifeda := false;
  98.                 inc(count);
  99.                 inc(score);
  100.         end;
  101.         if (Matrix[snake[0].y][snake[0].x] = bigedach)then
  102.         begin
  103.                 tlifedab := 0;
  104.                 lifedab := false;
  105.                 inc(count);
  106.                 inc(score, 4);
  107.         end;
  108.         Matrix[snake[0].y][snake[0].x]:=snch;
  109.         Matrix[snake[count].y][snake[count].x] := ' ';
  110. end;
  111.  
  112. procedure drawmatrix();
  113. var x,y:integer;
  114. begin
  115.         for y := 1 to Hm do
  116.         begin
  117.                 for x := 1 to Wm do
  118.                 begin
  119.                         if (Matrix[y][x] <> '$')then
  120.                         begin
  121.                                 gotoxy(x,y);
  122.                                 write( Matrix[y][x]);
  123.                                 if(Matrix[y][x]=' ')then Matrix[y][x] := '$';
  124.                         end;
  125.                 end;
  126.         end;
  127. end;
  128.  
  129. procedure randcord(var x:integer;var y:integer);
  130. begin
  131.        
  132.         repeat
  133.                 x := random(wm div 2);
  134.                 y := random(hm div 2);
  135.          until not ((Matrix[y][x] = snch) or (Matrix[y][x] = stena));
  136. end;
  137. var x,x1, y,y1:integer;
  138. procedure edap();
  139. begin
  140.  
  141.         if (not lifeda) then
  142.         begin
  143.                 randcord(x,y);
  144.                 lifeda := true;
  145.                 Matrix[y][x] := edach;
  146.         end;
  147.  
  148.        
  149.         if (1<=tlifedab) then begin
  150.                 dec(tlifedab);
  151.                 if(0 = tlifedab)then begin
  152.                         Matrix[y1][x1] := ' ';
  153.                         tlifedab := 0;
  154.                         lifedab := false;
  155.         end;
  156.         end;
  157.  
  158.         if (( tlifedab>0)
  159.         and((tick mod randbe + 1) = randbe))then
  160.         begin
  161.                 randbe := random(10)+ random(30)+100 + maxtlifeb;
  162.                 tlifedab := maxtlifeb;
  163.                 lifedab := true;
  164.                 randcord(x1, y1);
  165.                 Matrix[y1][x1] := bigedach;
  166.         end;
  167.        
  168.         gotoxy(x,y+1); 
  169. end;
  170.  
  171. begin
  172.                 randbe:= random(20)  + random(20)+10+maxtlifeb;
  173.         GameOver := false;
  174.         snake[0].x := (Wm) div 2;
  175.         snake[0].y := (Hm) div 2+5;
  176.         writeln( score);
  177.         snakep();
  178.         drawmatrix();
  179.         readkey;
  180.         while(not GameOver) do
  181.         begin
  182.                 onkeyboard();
  183.                 snakep();
  184.                 edap();
  185.                 drawmatrix();
  186.                 inc(tick);
  187.                 delay(150);
  188.         end;
  189.         clrscr;
  190.         writeln( 'GAMEOVER!!!');
  191.         writeln( 'score: ',score);
  192. end.

Share with your friends:

Распечатать