Lập trình trò chơi quân cờ trong Pascal

Chủ nhật - 09/08/2020 09:59

Trên một bàn cờ n x m có đặt n quân xe trắng và n quân xe đen sao cho trên mỗi cột đều có 1 xe trắng và 1 xe đen. Hai người A, B chơi với nhau một trò chơi như sau:
- A đi xe trắng, B đi xe đen.
- Các quân xe không ăn nhau, không được đi qua đầu nhau và chỉ được di chuyển trên một cột.
Hãy lập trình để máy tính chơi với người trò chơi trên với khả năng thắng cao nhất.

Hướng dẫn:
- Có thể đưa về bài toán bốc sỏi.
- Khoảng cách giữa 2 xe chính là số sỏi.
- Chú ý rằng số sỏi có thể tăng hoặc giảm.
Chương trình PASCAL chi tiết như sau:
uses crt;
const max=20;
          mu: array[0..4] of byte = (1,2,4,8,16);
type d=array[1..5] of 0..1;
var i,n,k,l,j,m, where1, where2, that, new1, new2: byte; may, người: 1..2;
           a: array[l..max,l..maxj of 0..2;
           have: array[l..max] of byte;
           cot: set of byte;
           b : d;
           suly: array[1..max] of d;
           truoc,trang,error,stop: boolean;
procedure draw;
begin
          textbackground(11);
          textcolor(15);
          clrscr,
          for i : = 1 to n do
          begin
               textcolor(14);
                gotoxy(30-n,i+12-(n div 2));Write(i: 3);
                gotoxy(30+i * 3-n,12-(n div 2));Write(i: 3);
                For j : = 1 to n do
                begin
                    gotoxy(31+i * 3-n,J+12-(n div 2));
                  if a[i,j]=o then.
                  begin
                      textcolor(7);
                      Writer (‘

’);
                  end;
                  if a[ij]=l then
                  begin
                      textcolor(15);
                      Writer (‘

’);
                  end;
                  if a[ij]=2 then
                  begin
                       textcolor(0);
                       Writer (‘

’);
                   end;
              end;
         end;
         procedure init;
         var ch: char;
         begin
              stop: = false;
              fillchar(a,sizeof(a),0);
              Writeln(‘Nhap kich thuoc n');
              repeat
                    clreol;
                    readln(n);
              until (n>0) and (n<21);
              Writeln ('Nhap gia tri k’);
              Repeat
                   clreol;
                   readln(m);
              until (m>0) and (m<= n);
              i : = 0;
              cot : = [];
              Repeat
                   j: = random(n)+1;
                  If (not (j in cot)) then
                      begin
                           i : = i+1;
                           cot : = cot+[j];
                           k: = random(n)+l;
                         repeat
                            1: = random(n)+l;
                         until 1< > k;
                         a[j,k] : = 1;
                         a[j,1] : = 2;
                    end;
       until i=m;
       draw;
       readln;
       textbackground(0);
       textcolor(15)
       clrscr;
       Writeln(‘Ban muon di quan trang hay den <1>: trang, <2>: den');
       repeat
            ch : = readkey;
            if ch = “1' then
            begin
                nguoi : = 1;
                may : = 2;
                trang : = true;
            end;
            if ch = '2' then
            begin
                nguoi : = 2;
                may : - 1;
                trang : = false;
            end;
      until (ch in ['1','2']);
      Writeln(‘Ban muon di truoc hay di sau <1 >: truoc, <2>: sau');
      repeat
           ch: = readkey;
           if ch='1' then truoc : = true;
           if ch='2' then truoc : = false;
      until (ch in ['1','2'1)1;
end;
procedure nguoidi;
var ch: char;
begin
     draw;
     stop : = true;
     for i : = 1 to n do
         if i in cot then
         begin
             for j : = 1 to n do
                  begin
                      if (a[i,j]=may) then where2 : = j;
                      if (a[i,j]=nguoi) then where1: - j;
                  end;
                  have[i]: = abs(where2-where1)-1;
                  if (have[i]< >0) or ((where1-n)*(where1-1)< >0)
                  then stop : = false;
          end;
          if stop = false then
          begin
              gotoxy(1,23);
              clreol;
              textcolor(4);
              write(‘Ban muon chon quan 0 cot thu may ?');
          repeat
              gotoxy(1,24);
              clreol;
              read(i);
          until i in cot;
          gotoxy(l,23);
          clreol;
          textcolor(4);
          writeln(‘Ban muon doi quan cua ban 0 cot, ',i,' sang hang nao ?');
          repeat
               gotoxy(l,24);
               clreol;
               read(j);
          until j in [1..n];
          For k : = 1 to n do
          begin
               if a[i,k]=nguoi then where 11: = k;
               if a[i,k]=may then where2 : = k;
          end;
          clreol;
          if ((wherel-where2)*(j-where2)<=0) or (where1=j) then
          begin
              error : = true;
              write(‘Ban da di sai luat. An phim ENTER de di lai...');
               readln;
          end;
         else
             begin a[i,wherel]: = 0;
             a[i,j] : = nguoi;
             error : = false;
             write(‘Ban da di dung luat. An phim ENTER de choi tiep...');
             readln;
         end;
    end;
    else
         begin
                 gotoxy(l,24);
                 clreol;
                 textcolor(4);
                 writeln(‘Ban da thua !');
                 clreol;
                 write(‘An ENTER de thoat...');
                 readln;
                 stop: = true;
         end;
    end;
procedure doihe( byte var c: d);
var p,tg,i: byte;
begin
    p : = 0;
    fillchar(c,sizeof(c),0);
    repeat
       inc(p);
       c[p] : = x mod 2;
       x : = x div 2;
       until x=0;
end;
procedure congmang;
var p: byte;
begin
     fillchar(b,sizeof(b),0);
     for i : = 1 to n do
     begin
         doihe(have[i],suly[i]);
         for j : = 1 to 5 do
         b[j]: = (b[j]+suly[i][j])mod 2;
     end;
end;
procedure maydi;
var ch : char;
begin
    draw;
    delay(random(500));
    that : = 21;
    for i : = 1 to n do
    if i in cot then
    begin .
        for j : = 1 to n do
        begin
            if (a[i,j]=may) then where2 : = j;
            if (a[i,j]=nguoi)then where1: = j;
        end;
        have[i] : = abs(wherel-where2)-l;
        if (have[i]< >0) or ((where2-n)* (where2-1)< >0) then that : = i;
        {dung cho khong tim ra duong di}
     end;
     else
          have[i] : = 0;
     congmang;
     i : = 6;
     repeat
          dec(i);
     until (i=0) or (b[i]=l);
     if b[i]=l then
         begin
             j : = 0;
             repeat
                  inc(j);
             until suly[j][i]=l;
             for k : = 1 to 5 do
                   if b[k]=1 then suly[j][k]: = abs(1-suly[j][k]);
             that: = 0;
             for 1: = 1 to 5 do
                  that : = that+suly|j][l]*mu[1-1];
             for k : = 1 to n do
             begin
                   if (a[j,k]=may) then where2 : = k;
                   if (a[j,k]=nguoi) then where 1: = k;
             end;
new1 : = where1+1+that;
new2 : = where 1-1-that;
if abs(new1-where2)>abs(new2-where2) then
    begin
        gotoxy(1,24);
        clreol;
        textcolor(4);
        writeln(‘May se doi quan cua may o cot ' j,' sang hang',new2);
         a[j,where2] : = 0;
         a[j,new2] : = may;
         clreol;
         Write(‘An phim ENTER de choi tiep...’);
         readln;
    end;
  else
    begin
        gotoxy(1,24);
        clreol;
        textcolor(4);
        writeln(’May se doi quan cua may o cot ’j,’ sang hang',new1);
        a[j,where2] : = 0;
        a[j,new1] : = may;
        cireol;
        write(An phim ENTER de choi tiep...');
        readln;
    end;
end;
else
    if that < >21 then
        begin
            for k : = 1 to n do
            begin
                if (a[that,k|=may) then where2 : = k;
                if (a[that,k]=nguoi) then where1 : = k;
            end;
            new1 : = where2+1;
            new2 : = where2-l;
            if ((have[that]>0) and (abs(new1-where2) > abs(new2-where2))) or ((have[tha=0) and (abs(newl=wherel) < abs(new2-wherel))) then
            begin
                gotoxy(l,24)
                clreol;
                textcolor(4);
               writeln(May se doi quan cua may o cot', that,'sang hang',new2);
               a[that,where2]: = 0;
               a[that,new2]: = may;
               clreol;
               Write(‘An phim ENTER de choi tiep...’) readln;
               end;
         else
              begin
                  gotoxy(l,24);
                  clreol;
                  textcolor(4);
                  writeln(May se doi quan cua may o cot', that,'sang hang',new1);
                  a[that,where2] : = 0;
                  a[that,new]: = may;
                  clreol;
                  Write(‘An phim ENTER de choi tiep...’);
                   readln;
              end;
         end;
         else
             begin
                  gotoxy(1,24);
                  clreol;
                  textcolor(4);
                 writeln(‘Ban da thang !');
                  clreol;
                  Write(‘An phim ENTER de thoat...');
                   readln;
                   stop : = true;
             end;
       end;
            begin
                clrscr;
               stop : = false;
                randomize;
                init;
                repeat
                   if truoc then
                       begin
                           repeat
                              nguoidi;
                           until error = false;
                          if sotp=false then maydi;
                      end;
                 else
                      begin
                          maydi;
                          if stop=false then
                              repeat
                                   nguoidi ;
                              until error = false;
                        end;
                  until stop;
                  textbackground(0);
                  clrscr;
                      end.

Lập trình trò chơi quân cờ trong Pascal

Theo dòng sự kiện

Lập trình trò chơi đổi màu bi trong Pascal

Lập trình trò chơi tính điểm quân đôminô trong Pascal

Những tin mới hơn

Lập trình trò chơi tính điểm quân đôminô trong Pascal

Lập trình trò chơi đổi màu bi trong Pascal

Những tin cũ hơn

Lập trình trò chơi bốc sỏi trong Pascal

Cách thiết kế một chương trình trò chơi trong pascal

DANH MỤC

Bài học mới