Tutorial Pascal: Buat Game Tetris
halo para penggemar pemograman sekalian,,,khususnya pascal,,,
o iya, hampir lupa,,,
sebelumnya saya mengucapkan selamat bagi peserta OSP (olimpiade sains provinsi) 2010 khususnya yang olimpiade komputer yang telah lewat ke ajang OSN (olimpiade sains Nasional...
oke, tanpa banyak basa-basi,,, ane mau share cara buat game tetris dengan menggunakan bahasa pemograman pascal... cuma ini masih belum stabil,,, mungkin
sobat2 blogger lain bisa memodifikasinya supaya lebih indah dan lebih keren,,
sehingga layak untuk di komersialkan,,,
sebelumnya saya memohon maaf kepada para master pascal,,jika ini adalah source jadul yang sama sekali tidak patut dihargai,,,
langkah pertama: download program free pascal,,,
2. instal program nya...
3. buka free pascal yg telah terinstal
4. paste kan source kode jadul berikut:
*==================================================*
program irez_andesda;
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('Play Again[Y/N]? ');
repeat
answer := upcase(readkey);
until answer in ['Y','N',#27];
if (answer = 'N') or (answer = #27) then break;
end;end.
*=======================================================*
setelah itu langsung compile dengan menggunakan ctrl + f9
jreeeeng,,,jreng,,,dapet deh,,hhehehe
silahkan perbaiki kesalahan saya ya sobat,,,
mohon komentarnya,,,
bagi para pengunjung yang berbaik hati kepada kelangsungan blog ini,,, harap klik salah satu iklan dibawah
Posted by Ikhwanesia.com
on 06.09. Filed under