Berita Terbaru:
Home » » Algoritma Game Tetris dalam pascal :

Algoritma Game Tetris dalam pascal :

2013-10-28 | 0 komentar

Algoritma Game Tetris dalam pascal :
Pengertian Game Tetris

Tetris adalah permainan teka-teki yang disusun dan diprogram oleh sepasang programmer berkebangsaan Rusia.Dalam permainan tetris, balok-balok tetris berjatuhan ke area permainan dalam waktu konstan.Balok tetris selalu terdiri dari 4 balok kecil yang membentuk 7 macam rupa.

Program : Tetris 1 Player naruto uzumaki like play the tetris game so if u like u must play tetris game

program tetris_1player;
uses crt;
type _points = array [1..4] of record
x,y : longint;
 end;
tetris = record
points : _points;cshape, nshape, xmodel, xtetris, ymodel, ytetris : longint;
end;

Const template : array [1..8] of _points =
(((x:1; y:1),(x:1; y:2),(x:2; y:1),(x:2; y:2)),
 ((x:2; y:1),(x:1; y:1),(x:3; y:1),(x:4; y:1)),
 ((x:1; y:2),(x:1; y:1),(x:1; y:3),(x:2; y:3)),
 ((x:2; y:2),(x:2; y:1),(x:2; y:3),(x:1; y:3)),
 ((x:1; y:2),(x:1; y:1),(x:2; y:2),(x:2; y:3)),
 ((x:1; y:2),(x:2; y:1),(x:2; y:2),(x:1; y:3)),
 ((x:1; y:2),(x:1; y:1),(x:1; y:3),(x:2; y:2)),
((x:1; y:2),(x:2; y:1),(x:2; y:2),(x:2; y:3)));

var field : array [1..79,1..25] of boolean;
        tetris1, tetris2, ttetris : tetris;
        quit,gameover : boolean;
         answer : char;
procedure init_field;
var i : longint;
begin
 clrscr;
 fillchar(field,sizeof(field),0);
     for i := 3 to 22 do
     begin
     textcolor(yellow);
 gotoxy(20,i); write(#186);    field[20,i] := true;
 gotoxy(36,i); write(#186); field[36,i] := true;
     end;
for i := 1 to 15 do
     begin
textcolor(yellow);
 gotoxy(20+i,23); write(#205); field[20+i,23] := true;
end;
 gotoxy(20,23); write(#200);
gotoxy(36,23); write(#188);
gotoxy(6,4); write('Next:');
end;

procedure drawtetris(objek : tetris; mode : Boolean);
var i : longint;
c : char;
begin
textcolor(green);
if mode then c := #178 else c := #33;
for i := 1 to 4 do
begin
 field[objek.points[i].x,objek.points[i].y] := mode;
gotoxy(objek.points[i].x, objek.points[i].y);
        write(c);
    end;
    gotoxy(1,1);
End;
procedure dropnew(var objek : tetris);
var i : longint;
begin
    if objek.cshape <> 0 then
    begin
        for i := 1 to 4 do
        begin
            ttetris.points[i].x := template[objek.nshape,i].x + objek.xmodel;
            ttetris.points[i].y := template[objek.nshape,i].y + objek.ymodel;
        end;
        drawtetris(ttetris,false);
    end;
    objek.cshape := objek.nshape;
    objek.nshape := random(8) + 1;
    for i := 1 to 4 do
    begin
        objek.points[i].x := template[objek.cshape,i].x + objek.xtetris;
        objek.points[i].y := template[objek.cshape,i].y + objek.ytetris;
        ttetris.points[i].x := template[objek.nshape,i].x + objek.xmodel;
        ttetris.points[i].y := template[objek.nshape,i].y + objek.ymodel;
 if field[objek.points[i].x,objek.points[i].y] then
begin
            gameover := true;
            break;
        end;
    end;
    drawtetris(objek,true);
    drawtetris(ttetris,true);
end;

procedure init_tetris(var objek : tetris; id : longint);
begin
     objek.nshape := random(8) + 1;
     if id = 1 then
     begin
 objek.xmodel := 7;                                    objek.xtetris := 26;
     end else begin
        objek.xmodel := 47; objek.xtetris := 66;
     end;
 objek.ymodel := 5; objek.ytetris := 2;
     dropnew(objek);
end;

procedure eliminate(objek : tetris; y : longint);
var i,j,k : longint;
    blank : boolean;
begin
    for i := y downto 3 do
    begin
        blank := false;
        for j := objek.xmodel + 14 to objek.xmodel + 28 do
            if not field[j,i] then
            begin
                blank := true;
                break;
            end;
        if not blank then
        begin
            for k := i downto 3 do
            begin
                gotoxy(objek.xmodel + 14,k);
                for j := (objek.xmodel + 14) to (objek.xmodel + 28) do
                begin
 if field[j,k-1] then write(#178) else write(#32)   field[j,k] := field[j,k-1];
                end;
            end;
            eliminate(objek,i);
            break;
        end;
    end;
end;

procedure slide(var objek : tetris);
var i : longint;
    dropped : boolean;
begin
    drawtetris(objek,false);
    ttetris := objek;
    dropped := false;
    for i := 1 to 4 do
    begin
        inc(ttetris.points[i].y);
        if field[ttetris.points[i].x,ttetris.points[i].y] then
        begin
            dropped := true;
            break;
        end;
    end;
    if not dropped then objek := ttetris;
    drawtetris(objek,true);
    if dropped then
    begin
        eliminate(objek,22);
        dropnew(objek);
    end;
end;

procedure rotate(var objek : tetris);
var i : longint;
    collide : boolean;
begin
    drawtetris(objek,false);
    ttetris := objek;
    collide := false;
    for i := 2 to 4 do
    begin
        ttetris.points[i].y := objek.points[1].y + objek.points[i].x - objek.points[1].x;ttetris.points[i].x := objek.points[1].x - objek.points[i].y + objek.points[1].y;
 if field[ttetris.points[i].x,ttetris.points[i].y] then
        begin
            collide := true;
            break;
        end;
    end;
    if not collide then objek := ttetris;
    drawtetris(objek,true);
end;

procedure shift(var objek : tetris; x, y : longint);

 
var i : longint;
    collide : boolean;
begin
    drawtetris(objek,false);
    ttetris := objek;
    collide := false;
    for i := 1 to 4 do
    begin
        ttetris.points[i].x := objek.points[i].x + x;
        ttetris.points[i].y := objek.points[i].y + y;
        if field[ttetris.points[i].x,ttetris.points[i].y] then
        begin
            collide := true;
            break;
        end;
    end;
   if not collide then objek := ttetris;
    drawtetris(objek,true);
    if collide then eliminate(objek,22);
end;

procedure userinput;
var i : longint;
    c : char;
begin textcolor(red);
    for i := 1 to 20 do
    begin textcolor(red);
        if keypressed then
        begin  textcolor(red);
             c := upcase(readkey);
             case c of
 #72 : if tetris1.cshape <>1 then rotate(tetris1); #75 : shift(tetris1,-1,0);
#80 : shift(tetris1,0,1);
 #77 : shift(tetris1,1,0);
#27 : gameover := true;
#32 : repeat delay(50); until keypressed;
             end;
        end;
        delay(50);
    end;
end;

begin
    randomize;
    while not quit do
    begin
        init_field;
        init_tetris(tetris1,1);
        gameover := false;
        while not gameover do
        begin
            slide(tetris1);
            userinput;
        end;
        gotoxy(1,25); write('Play Again[Y/N]? ');
        repeat
            answer := upcase(readkey);
        until answer in ['Y','N',#27];
  if (answer = 'N') or (answer = #27) then break;
 end;
end.

Like dan bagikan :

Tidak ada komentar:

Posting Komentar

 
Copyright © 2011. Satu Cerita Untuk Semua™ - All Rights Reserved