Rabu, 30 November 2016

Membuat game TETRIS di IDE Pascal

Mimin mau ngepost lagi nih tentang aplikasi IDE Pascal..
Kalian pasti mengira.. "Mana mungkin Pascal di pakai main game", "Ini kan tempat nge Script, masa bisa main game" dan lain lainnya.

Tapi memang beneran ada scriptnya buat game Tetris di pascal..



bila kalian mau bisa ambil script nya di bawah ini


program tetris_2player;

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
        gotoxy(20,i); write(#186); field[20,i] := true;
        gotoxy(36,i); write(#186); field[36,i] := true;
        gotoxy(60,i); write(#186); field[60,i] := true;
        gotoxy(76,i); write(#186); field[76,i] := true;
     end;
     for i := 1 to 15 do
     begin
        gotoxy(20+i,23); write(#205); field[20+i,23] := true;
        gotoxy(60+i,23); write(#205); field[60+i,23] := true;
     end;
     gotoxy(20,23); write(#200);
     gotoxy(60,23); write(#200);
     gotoxy(36,23); write(#188);
     gotoxy(76,23); write(#188);
     gotoxy(6,4); write('Next:');
     gotoxy(46,4); write('Next:');
end;

procedure drawtetris(objek : tetris; mode : Boolean);
var i : longint;
c : char;
begin
if mode then c := #178 else c := #32;
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
    for i := 1 to 20 do
    begin
        if keypressed then
        begin
             c := upcase(readkey);
             case c of
             'W' : if tetris1.cshape <> 1 then rotate(tetris1);
             #72 : if tetris2.cshape <> 1 then rotate(tetris2);
             'A' : shift(tetris1,-1,0);
             #75 : shift(tetris2,-1,0);
             'S' : shift(tetris1,0,1);
             #80 : shift(tetris2,0,1);
             'D' : shift(tetris1,1,0);
             #77 : shift(tetris2,1,0);
             #27 : gameover := true;
             #32 : repeat delay(10); until keypressed;
             end;
        end;
        delay(10);
    end;
end;

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





Jangan lupa tinggalkan komentar mengenai program yang saya bagikan. Bila menemukan masalah bisa tanyakan admin di CHAT BOX atau di KOMENTAR..

Trimakasih.
Disqus Comments