Trò chơi Rắn trườn

Đây là code của bạn Vũ Văn Thưởng viết năm 2010 (Bạn Thưởng hiện nay đang là sinh viên năm ba, hệ cử nhân Tài năng của Đại học Bách Khoa)

Chương trình được viết trên Turbo Pascal.

Program ChuongTrinh;
uses crt, graph;
const Xmin = 80;         rong = 10;            delays = 30;
      Ymin = 80;         buoc = 10;
      Xmax = 501;        kho = 6;
      Ymax = 362;
      color1 = blue;        { mau cua diem ngau nhien  }
      color2 = blue;        { mau cua ran }
      color3 = 2;        	{ mau xung quanh nen }
      color4 = yellow;      { mau nen }
type  CC = record
                 xx, yy: word;
           end;
var a, rao: Array[1..200] of CC;    c: cc;
    Dokho: shortint;

    x, y: word; j:char;  b, k: byte;   ddm, ddm2: integer; ch: string;
    stop: boolean ;

          procedure graphx(driver, mode: integer; dcgraph: string);
          { khoi tao do hoa }
          begin
               initgraph(driver, mode, dcgraph);
               cleardevice;
               setfillstyle(11, color3);
               bar(1, 1, getmaxx, getmaxy);
               settextstyle(2, 0, 5);
               outtextxy(10, getmaxy - 50, 'Press ESC to exit...');
               outtextxy(20, getmaxy - 70,'Vu Van Thuong');
          end;

          procedure khung;            { tao khung }
          begin
               setfillstyle(1, color4);
               bar(xmin, ymin, xmax, ymax);
          end;

          procedure raocan;           { tao vat can }
          var i, j: byte;
          begin
          end;

          procedure diem;
          { tao ngau nhien o vuong[rong x rong] trong khung }
          var x0, y0: word; i: word; zz: byte;
          begin
               randomize;
               zz:= abs(rong - buoc) div 2  ;
               x:= buoc*random((Xmax - buoc - Xmin) div buoc) + Xmin;
			   { tao ngau nhien tao do x }
               y:= buoc*random((Ymax - buoc - Ymin) div buoc) + Ymin;
			   { tao ngau nhien tao do y }
               setfillstyle(14, color1);          { tao mau }
               bar(x + zz + 1, y + zz + 1, x + zz + rong, y + zz + rong);
			   { ve hcn rong x rong }
          end;

          procedure dong(var k: byte);   { tao su di chuyen }
          var i: byte; zz: byte;   sss: byte;
          begin
               zz:= abs(rong - buoc) div 2    ;
               for i:= b + 1 downto 2 do a[i]:= a[i - 1]; { doi toa do diem }
               with a[1] do
               begin
                    case k of
                         1: dec(yy, buoc);
                         2: dec(xx, buoc);
                         3: inc(xx, buoc);
                         4: inc(yy, buoc);
                    end;

                    setfillstyle(1, color4);

                    with a[b + 1] do
                         bar(xx + zz + 1, yy + zz + 1, xx + zz + rong, yy + zz + rong);
                         { ve hcn trang trong khung -- xoa hcn }
                    setfillstyle(1, color2);
                    bar(xx + zz + 1, yy + zz + 1, xx + zz + rong, yy + zz + rong);
					{ve hcn tai a[1] }
               end;
               if (ddm = -dokho) or ((x = A[1].xx) and (y = A[1].yy)) then
               begin
                    ddm:= ddm + dokho;
                    diem;
                    if b < 255 then b:= b + 1;
                    if (b = trunc(b/10)*10) and (dokho < 10) then
                    begin
                         inc(dokho);
                    end;
               end      { kt toa do dau va toa do ngau nhien }
               else  if  (ddm = -dokho) or ((x = A[b + 1].xx) and (y = A[b + 1].yy))
			   then
               begin
                    ddm:= ddm + dokho;
                    diem;
                    if b < 255 then b:= b + 1;
                    if (b = trunc(b/10)*10) and (dokho < 10) then
                    begin
                         inc(dokho);
                    end;
               end;
               stop:= false;
               for i:= 2 to b do
               if (A[1].xx = A[i].xx) and (A[1].yy = A[i].yy) then stop:= true;
               if (a[1].xx < xmin) or (a[1].xx > xmax - buoc) or (a[1].yy < ymin)
				  or (a[1].yy > ymax - buoc) then stop:= true;
          end;

          procedure tudong;      { tu dong chay khi khong su dung phim }
          var i: byte;
          begin
               repeat
                     if not (keypressed) then
                     begin
                          dong(k);
                          for i:= 1 to 10 - dokho do { tao muc do kho }
                          delay(delays);
                          delay(delays);
                     end
                        else j:= readkey;
                        if j = #27 then halt;
                        if ddm2 <> ddm then
                        begin
                             ddm2:= ddm;
                             str(ddm, ch);
                             ch:= 'Diem: ' + ch;
                             setfillstyle(11, color3);
                             bar(1, 14, 200, ymin - 10);
                             outtextxy(16, 8, ch);
                        end;
               until (j in [#72, #75, #77, #80, #27]) or (stop);
          end;

          procedure ct;           { kt lenh tu ban phim }
          var i: byte;
          begin
               repeat
                     tudong;
                     case j of
                          #72, '8': if not (k = 4) then k:= 1;     {}
                          #75, '4': if not (k = 3) then k:= 2;     {<}
                          #77, '6': if not (k = 2) then k:= 3;     {>}
                          #80, '2': if not (k = 1) then k:= 4;     {}
                     end;
               until (j = #27) or (stop);
               outtextxy(80, 360, 'Press Enter to restart...');
          end;

Begin { Chuong Trinh Chinh }
     j:= #13;
     repeat
           if j = #13 then
           begin
                clrscr;
                stop:= false;
                k:= 0;
                graphx(0, 0, '');
                settextstyle(1, 0, 2);
                dokho:= kho;
                ddm:= -dokho;
                ddm2:= ddm;
                khung;
                b:= 0;
                a[1].xx:= Xmin;
                a[1].yy:= ymin + ((ymax - ymin) div 2 div buoc)*buoc;
                ct;
           end;
           j:= readkey;
           closegraph;
     until j = #27;
end.
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: