www.gcmsite.ru

Новости Программы PHP-скрипты Статьи Числа
Услуги Резюме Игры Автомобили Поиск

СИСТЕМНОЕ И ВЕБ-ПРОГРАММИРОВАНИЕ
компьютерная техника, игры

Нужна программа, скрипт или сайт? Анализ сайта или оптимизация? Копирайт или рерайт текстов? Заявка на выполнение работ.

Разработка простейшей аркадной игры "Тетрис"

Дата написания: 11.12.2016

Статья предназначена для начинающих программистов. Задача: написать игру, - упрощенный вариант "Тетриса". Реализован поворот лишь на 90 градусов.

Для описания программного кода будет использоваться Borland Pascal 7.0

Program Tetris_Version_1;             {    Make 05.12.1998    }
  Uses                                {  All rights reserved  }
    Crt,Dos;
  Const
    n = 4;
    a1: array[1..n,1..n] of byte = ((0,0,0,0),
                                    (0,1,1,0),
                                    (0,1,1,0),
                                    (0,0,0,0));
 
    a2: array[1..n,1..n] of byte = ((0,0,0,0),
                                    (0,1,0,0),
                                    (0,1,0,0),
                                    (0,1,1,0));
 
    a3: array[1..n,1..n] of byte = ((0,0,0,0),
                                    (0,0,1,0),
                                    (0,0,1,0),
                                    (0,1,1,0));
 
    a4: array[1..n,1..n] of byte = ((0,0,0,0),
                                    (0,1,0,0),
                                    (0,1,1,0),
                                    (0,0,1,0));
 
    a5: array[1..n,1..n] of byte = ((0,0,0,0),
                                    (0,0,1,0),
                                    (0,1,1,0),
                                    (0,1,0,0));
 
    a6: array[1..n,1..n] of byte = ((0,1,0,0),
                                    (0,1,0,0),
                                    (0,1,0,0),
                                    (0,1,0,0));
 
    a7: array[1..n,1..n] of byte = ((0,0,0,0),
                                    (0,1,0,0),
                                    (0,1,1,0),
                                    (0,1,0,0));
  Var
    key              : char;
    stop             : Boolean;
    hsc,sc           : integer;
    startskor,skor   : integer;
    x,y              : byte;
    stopgame,sig     : boolean;
    a,b              : array [1..4,1..4] of byte;
    c                : array [-1..16,1..25,1..2] of byte;
    babaxvalue       : boolean;
    colorfig         : byte;
    movingtrue       : boolean;
{----------------------------------------------------------------}
  procedure cursoroff;
    begin
      asm
        mov ah,1
        mov cx,$0100
        int $10
      end
    end;
{----------------------------------------------------------------}
  procedure start;
    var
      d  : string[30];
      t  : byte;
    begin
      d:='Евгений Шаров представляет    ';
      clrscr;
      delay(1000);
      textcolor(1);
      for t:=1 to 15 do
        begin
          gotoxy(6+(t*2),12);
          write(d[t*2]);
          delay(40);
          gotoxy(5+(t*2),12);
          write(d[t*2-1]);
          delay(40)
        end;
      delay(2100);
      clrscr;
      delay(900);
      d:='П Р О Г Р А М М У           ';
      clrscr;
      textcolor(1);
      for t:=1 to 30 do
        begin
          gotoxy(11+t,12);
          write(d[t]);
          delay(40)
        end;
      delay(2100);
      textmode(3);
      cursoroff;
      delay(1500);
      while not keypressed do
        begin
          gotoxy(20,7);
          textcolor(random(14)+1);
          writeln('----------¬');
          gotoxy(20,8);
          writeln('L---¬ -----');
          gotoxy(20,9);
          writeln('    ¦ ¦-----¬------¬-----¬--¬  --¬-----¬');
          gotoxy(20,10);
          writeln('    ¦ ¦¦ ----L-¬ ---¦ -¬ ¦¦ ¦ /  ¦¦ ----');
          gotoxy(20,11);
          writeln('    ¦ ¦¦ L--¬  ¦ ¦  ¦ L- ¦¦ ¦/ / ¦¦ ¦   ');
          gotoxy(20,12);
          writeln('    ¦ ¦¦ ----  ¦ ¦  ¦ ----¦ / /¦ ¦¦ ¦   ');
          gotoxy(20,13);
          writeln('    ¦ ¦¦ L--¬  ¦ ¦  ¦ ¦   ¦  / ¦ ¦¦ L--¬');
          gotoxy(20,14);
          writeln('    L--L-----  L--  L--   L--  L--L-----');
          delay(800);
        end;
      key:=readkey;
      if key = #0
        then
          key:=readkey;
      clrscr;
      delay(1000);
      textmode(1)
    end;
{----------------------------------------------------------------}
  procedure help;
    begin
      clrscr;
      textcolor(lightgreen);
      writeln;
      writeln(' ':13,'Hello,Baby...');
      writeln('');
      writeln('');
      writeln('');
      writeln('');
      writeln('');
      writeln('');
      writeln('');
      readkey;
      textcolor(blue);
      clrscr
    end;
{----------------------------------------------------------------}
  procedure rand;
    var
      h  : integer;
      i,j : byte;
    begin
      randomize;
      h:=0;
      while not (h in [1..7]) do
        h:=random(9);
      i:=colorfig;
      colorfig:=1;
      while not (colorfig in [10,11,13,14,15]) do
        begin
          colorfig:=random(16);
          if i = colorfig
            then
              colorfig:=1
        end;
      case h of
       1:
         for i:=1 to 4 do
           for j:=1 to 4 do
             a[i,j]:=a1[i,j];
       2:
         for i:=1 to 4 do
           for j:=1 to 4 do
             a[i,j]:=a2[i,j];
       3:
         for i:=1 to 4 do
           for j:=1 to 4 do
             a[i,j]:=a3[i,j];
       4:
         for i:=1 to 4 do
           for j:=1 to 4 do
             a[i,j]:=a4[i,j];
       5:
         for i:=1 to 4 do
           for j:=1 to 4 do
             a[i,j]:=a5[i,j];
       6:
         for i:=1 to 4 do
           for j:=1 to 4 do
             a[i,j]:=a6[i,j];
       7:
         for i:=1 to 4 do
           for j:=1 to 4 do
             a[i,j]:=a7[i,j]
      end
    end;
{----------------------------------------------------------------}
  procedure status;
    begin
      if sc>hsc
        then
          hsc:=sc;
      textbackground(7);
      textcolor(10);
      gotoxy(1,2);
      write('             ');
      gotoxy(1,3);
      write('             ');
      gotoxy(1,2);
      write('Score  :',sc:5);
      gotoxy(1,3);
      write('HScore :',hsc:5);
      textbackground(0);
    end;
{----------------------------------------------------------------}
  procedure moving(what:byte);
    var
      ss  : boolean;
      i,j : byte;
    begin
      ss:=true;
      if (x<14) or (x>24)
        then
          exit;
      case what of
        0 :
         begin
           for i:=x-14 to x-8 do
             for j:=Y to y+3 do
               begin
               if i = -1
                 then
                   begin
                     i:=0;
                     ss:=false
                   end;
               if c[i,j,1] = 1
                 then
                   if c[i-1,j,1] = 2
                     then
                       ss:=false
               end;
           if ss
             then
               begin
                 for i:=x-14 to x-8 do
                   for j:=Y to y+3 do
                     if c[i,j,1] = 1
                       then
                         begin
                           c[i-1,j,1]:=1;
                           c[i,j,1]:=0;
                           c[i-1,j,2]:=colorfig;
                           c[i,j,2]:=0
                         end;
                 x:=x-1;
                 movingtrue:=true
               end
         end;
        1 :
         begin
           for i:=x-14 to x-8 do
             for j:=Y to y+3 do
               begin
               if i = 24
                 then
                   begin
                     i:=23;
                     ss:=false
                   end;
               if c[i,j,1] = 1
                 then
                   if c[i+1,j,1] = 2
                     then
                       ss:=false
               end;
           if ss
             then
               begin
                 for i:=x-8 downto x-14 do
                   for j:=Y to y+3 do
                     if c[i,j,1] = 1
                       then
                         begin
                           c[i+1,j,1]:=1;
                           c[i,j,1]:=0;
                           c[i+1,j,2]:=colorfig;
                           c[i,j,2]:=0
                         end;
                 x:=x+1;
                 movingtrue:=true
               end
         end;
        2 :
         begin
           for i:=x-14 to x-8 do
             for j:=Y to y+3 do
               begin
               if i = -1
                 then
                   begin
                     i:=0;
                     ss:=false
                   end;
               if i = 24
                 then
                   begin
                     i:=23;
                     ss:=false
                   end;
               if c[i,j,1] = 1
                 then
                   if c[i,j+1,1] = 2
                     then
                       ss:=false
               end;
           if ss
             then
               begin
                 for i:=x-14 to x-8 do
                   for j:=Y+3 downto y do
                     if c[i,j,1] = 1
                       then
                         begin
                           c[i,j+1,1]:=1;
                           c[i,j,1]:=0;
                           c[i,j+1,2]:=colorfig;
                           c[i,j,2]:=0;
                         end;
                 y:=y+1;
                 movingtrue:=true
               end
         end
      end
    end;
{----------------------------------------------------------------}
  procedure paint;
    var
      i,j,h      : byte;
    begin
      for i:=1 to 11 do
        for j:=1 to 21 do
          begin
            case c[i,j,1] of
              0  : textcolor(0);
              1,2: textcolor(c[i,j,2]);
            end;
            gotoxy(14+i,0+j);
            write(#$db)
          end
    end;
{----------------------------------------------------------------}
  procedure babax;
    var
      i,j  : integer;
      ss   : boolean;
    begin
      ss:=true;
      for i:=x-14 to x-8 do
        for j:=y to y+3 do
          if c[i,j,1] = 1
            then
              if c[i,j+1,1] = 2
                then
                  ss:=false;
      if not ss
        then
          begin
            for i:=x-14 to x-8 do
              for j:=y+3 downto y do
                if c[i,j,1] = 1
                  then
                    c[i,j,1]:= 2;
            babaxvalue:=true;
            sound(70);
            delay(50);
            nosound
          end
    end;
{----------------------------------------------------------------}
  procedure secondscreen;
    begin
      textcolor(14);
      textbackground(7);
      gotoxy(27,2);
      write('ESC выход    ');
      gotoxy(27,3);
      write('P пауза      ');
      gotoxy(27,4);
      write('N по час     ');
      gotoxy(27,5);
      write('M против час ');
      gotoxy(27,6);
      write(#25' вниз       ');
      gotoxy(27,7);
      write(#27' влево      ');
      gotoxy(27,8);
      write(#26' вправо     ')
    end;
{----------------------------------------------------------------}
  procedure screen;
    var
      i,j  : byte;
    begin
      clrscr;
      textcolor(7);
      for i:=1 to 24 do
        begin
          gotoxy(1,i);
          write('--------------');
          gotoxy(27,i);
          write('-------------')
        end;
      for i:=1 to 2 do
        begin
          gotoxy(15,i+22);
          write('------------')
        end;
      textcolor(4);
      for i:=1 to 22 do
        begin
          gotoxy(14,i);
          write('-');
          gotoxy(26,i);
          write('-')
        end;
      gotoxy(15,22);
      write('-----------');
      status;
      secondscreen;
      textbackground(0)
    end;
{----------------------------------------------------------------}
  procedure count;
    var
      i,j,k : integer;
      ss     : boolean;
    begin
      for i:=1 to 21 do
        begin
          ss:=true;
          for j:=1 to 11 do
            if c[j,i,1]<>2
              then
                ss:=false;
          if ss
            then
              begin
                for j:=1 to 11 do
                  begin
                    c[j,i,1]:=0;
                    c[j,i,2]:=0;
                    sc:=sc+1
                  end;
                for k:=i downto 1 do
                  for j:=1 to 11 do
                    if c[j,k,1] = 2
                      then
                       begin
                         c[j,k+1,1]:=2;
                         c[j,k,1]:=0;
                         c[j,k+1,2]:=c[j,k,2];
                         c[j,k,1]:=0;
                       end;
              end;
        end;
      textbackground(7);
      textcolor(10);
      gotoxy(1,2);
      write('             ');
      gotoxy(1,3);
      write('             ');
      gotoxy(1,2);
      write('Score  :',sc:5);
      gotoxy(1,3);
      write('HScore :',hsc:5);
      textbackground(0)
    end;
{----------------------------------------------------------------}
  procedure circlefig(r:byte);
    var
      aa    : array [1..4,1..4] of byte;
      cc    : array [1..4] of byte;
      i,j   : byte;
    begin
      if (x<15) or (x>21)
        then
          exit;
      case r of
        1:
          for i:=1 to 4 do
            begin
              for j:=1 to 4 do
                cc[j]:=a[i,j];
              for j:=4 downto 1 do
                aa[5-j,i]:=cc[j]
            end;
        2:
          for i:=1 to 4 do
            begin
              for j:=1 to 4 do
                cc[j]:=a[i,j];
              for j:=1 to 4 do
                aa[j,5-i]:=cc[j]
            end;
      end;
      for i:=x-14 to x-11 do
        for j:=y to y+3 do
          begin
            c[i,j,1]:=aa[i-x+15,j+1-y];
            if c[i,j,1] = 1
              then
                 c[i,j,2]:=colorfig;
            if c[i,j,1] = 0
              then
                 c[i,j,2]:=0;
          end
    end;
{----------------------------------------------------------------}
  procedure nastr;
    var
      stop      : boolean;
      x,y       : byte;
    begin
      clrscr;
      window(1,1,40,8);
      textbackground(5);
      clrscr;
      textcolor(14);
      stop:=false;
      gotoxy(3,3);
      writeln('    ',#26,' Ускорить     ',#27,' Затормозить');
      writeln('       ENTER-выход в главное меню');
      textcolor(10);
      x:=3;
      y:=6;
      while not stop do
        begin
          while not keypressed do
            begin
              gotoxy(x-1,y);
              write(' ',#2);
              delay(startskor);
              x:=x+1;
              if x = 37
                then
                  begin
                    gotoxy(x-2,y);
                    write('   ');
                    x:=3
                  end
            end;
          key:=readkey;
          if key = #13
            then stop:=true;
          if key = #0
            then
              begin
                key:=readkey;
                case key of
                  #75 : begin
                          startskor:=startskor+10;
                          if startskor = 250
                            then
                              startskor:=240
                        end;
                  #77 : begin
                          startskor:=startskor-10;
                          if startskor = 0
                            then
                              startskor:=10
                        end
                end
              end
        end;
      window(1,1,40,25);
      textbackground(1);
      clrscr
    end;
{----------------------------------------------------------------}
  procedure klavisha;
    begin
      if  keypressed
        then
          begin
            key:=readkey;
            if key = #27
              then
                begin
                  gotoxy(15,10);
                  textcolor(green);
                  write('Закончить ?');
                  gotoxy(16,11);
                  write('Y for yes');
                  key:=readkey;
                  if key in ['y','Y','Н','н']
                    then
                      begin
                        stopgame:=true;
                        paint;
                        exit
                      end;
                  if key = #0
                    then
                      key:=readkey;
                  exit
                end;
            if key in ['n','N','т','Т']
              then
                circlefig(2);
            if key in ['ь','Ь','m','M']
              then
                circlefig(1);
            if key in ['p','P','з','З']
              then
                begin
                  gotoxy(18,10);
                  textcolor(green+blink);
                  write('Пауза');
                  while not keypressed do;
                  key:=readkey;
                  if key = #0
                    then
                      key:=readkey;
                  exit
                end;
            if key = #0
              then
                begin
                  key:=readkey;
                  case key of
                    #75:
                         begin
                           moving(0) { left }
                         end;
                    #77:
                         begin
                           moving(1) { rigth }
                         end;
                    #72:
                         begin
                         end;
                    #80:
                         begin
                           moving(2)   { down }
                         end
                  end
                end
          end
    end;
{----------------------------------------------------------------}
  procedure game;
    var
      i,j   :  integer;
    begin
      textbackground(0);
      x:=18;
      y:=1;
      sc:=0;
      rand;
      for i:=1 to 22 do
        begin
          c[0,i,1]:=2;
          c[12,i,1]:=2
        end;
      for i:=0 to 12 do
        c[i,22,1]:=2;
      for i:=1 to 11 do
        for j:=1 to 21 do
          c[i,j,1]:=0;
      for i:=4 to 7 do
        for j:=1 to 4 do
          c[i,j,1]:=a[i-3,j];
{      inc(x);}
      babaxvalue:=false;
      screen;
      stopgame:=false;
      movingtrue:=false;
      skor:=startskor*130;
      while not stopgame do
        begin
          i:=0;
          while i < skor do
            begin
              klavisha;
              if stopgame
                then
                  break;
              if movingtrue
                then
                  begin
                    paint;
                    movingtrue:=false;
                    i:=i+300
                  end;
              i:=i+1
            end;
          if stopgame
            then
              break;
          moving(2);  { down }
          paint;
          babax;
          if babaxvalue
            then
              begin
                count;
                if y in [1..2]
                  then
                    begin
                      stopgame:=true;
                      break
                    end;
                rand;
                inc(sc);
                status;
                x:=18;
                y:=1;
                for i:=4 to 7 do
                  for j:=1 to 4 do
                    c[i,j,1]:=a[i-3,j];
{                inc(x); }
                babaxvalue:=false
              end;
        end;
      gotoxy(16,10);
      textcolor(green+blink);
      write('Game over');
      status;
      while keypressed do
        key:=readkey;
      while not keypressed do;
        key:=readkey;
      if key = #0
        then
          key:=readkey;
      textbackground(1);
      clrscr
    end;
{----------------------------------------------------------------}
BEGIN
  randomize;
  textmode(1);
  cursoroff;
  start;
  textbackground(1);
  clrscr;
  cursoroff;
  stop:=false;
  startskor:=50;
  hsc:=0;
  while not stop do
    begin
      textcolor(11);
      gotoxy(11,21);
      writeln('All rights reserved.');
      textcolor(14);
      gotoxy(11,6);
      writeln('<<< Death Tetris >>>');
      textcolor(15);
      gotoxy(10,11);
      write('Игра.................1');
      gotoxy(10,12);
      write('О программе..........2');
      gotoxy(10,13);
      write('Настройка............3');
      gotoxy(10,14);
      write('Выход в ДОС..........4');
      key:=readkey;
      case key of
        '1' : game;
        '2' : help;
        '3' : nastr;
        '4' : stop:= not stop;
        else
          begin
            Sound(160);
            Delay(17);
            NoSound
          end
      end
    end;
  textmode(3)
END.




Prolog — это язык логического программирования. Он является декларативным языком: вся стуктура программы представлена в виде правил и фактов. На нем можно строить экспертные системы, генерирующие ответы вида true (истина) или false (ложь). Пролог хорошо подходит для автоматического перебора вариантов решений с возвратами. Язык не требует написания большого объемного кода и позволяет получать отличные результаты.

Интересные материалы на сайте:

Рейтинг@Mail.ru     Автор, разработчик: Шаров Евгений   (gcmsite@yandex.ru)
(c) 2000-2017 GCM-Site - системное и веб-программирование
Цитирование материалов сайта возможно только при наличии гиперссылки