Home » » bikin game Tetris 2 pleyer pake free pascal

bikin game Tetris 2 pleyer pake free pascal

Zul Kadry | 18.00 | 0 komentar
walu pu pascal  Pascal sering dikonotasikan sebagai  bahasa pemrograman yang kuno karena tampilannya masih menggunakan DOS, tapi ternyata bisa dipake untuk bikin game  , klo gak percaya tes aja algoritma 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('masih mau ki main[Y/N]? ');
        repeat
            answer := upcase(readkey);
        until answer in ['Y','N',#27];
        if (answer = 'N') or (answer = #27) then break;
    end;
end.


hasilnya setelah di jalankan
sumber : ilmukomputer.org

Share this article :
Related Posts Plugin for WordPress, Blogger...
 
Support : Creating Website | Johny Template | Mas Template
Copyright © 2011. Kadry Tekno Blog - All Rights Reserved
Template Modify by Creating Website
Proudly powered by Blogger