|
Displaying Source Code(s)
|
|
tetris (Mini Project)
--------------------------------------------------------------------------------
Description : Not Specified
Code :
program tetris;{tetris game, writen by 'mehdi
farrokhzad',project term 1}
uses crt,graph; {started at 83/9/22 to 83/ / time in work(12)
hours}
type {this game is programmed for pascal project in term 1 '83'}
matris=array[1..15,1..20]of boolean;{teacher:dr ebrahimi}
var
driver,mode,i,j,shekl,rd,xstart,ystart,xend,yend,rd2,x,lpixel:integer;
leftchannel,rightchannel,rpixel
,downchannel1,downchannel2,downchannel3:integer;
tetrix:boolean;
key,keyup,keydown,keyleft,keyright,space,keyy:char;
matrix:matris;
procedure logo;
begin{logo}
bar(50,100,80,200);{darw t}
bar(20,100,110,100);
bar(150,100,180,200);{draw e}
bar(180,100,210,120);
bar(180,140,210,160);
bar(180,180,210,200);
bar(280,100,310,200);{draw t}
bar(250,100,340,100);
bar(380,100,410,200);{draw r}
arc(410,125,270,90,25);
line(410,150,435,200);
bar(480,100,510,200);{draw i}
circle(495,75,25);
floodfill(495,77,white);
arc(600,125,0,180,35);{draw s}
line(565,125,635,125);
line(565,125,635,165);
arc(600,165,180,0,35);
line(565,165,635,165);
floodfill(600,110,white);
floodfill(600,170,white);
outtextxy(200,getmaxy-50,'please enter to load game...');
end;{logo}
{---------------------------------------------------}
procedure music; {music attached from hangman}
var o,go,
z2,z4,z8,z16,k : integer;
d,dd,r,rd,m,f,fd,c,cd,l,ld,si : integer;
{**************************************************}
procedure s(n,z:integer);
var k,k2 : integer;
begin
sound(o*n*go);
delay(z);
nosound;
end;
{***************************************************}
begin
d := 65; dd := 69; r := 73; rd := 78; go:=3;
m := 82; f := 87; fd := 93; c := 98;
cd := 104; l := 110; ld := 117; si := 123;
{********************************************************}
z2 := 800; z4 := round(z2/2); z8 := round(z2/4);
z16 := round(z2/8); o := 1;
s(l,z8); s(si,z8); o := 2;
s(d,z8); o := 1; s(si,z8);
o := 2; s(r,z8); s(d,z8); o := 1; s(si,z8); s(l,z8);
s(si,z4); s(si,z4); s(si,z4);
end;{end of music of logo}
{------------------------------------------------------}
procedure rectangl;
begin{draw rectangle}
rectangle(149,49,451,451);
outtextxy(460,100,'score:');
outtextxy(180,40,'T E T R I S')
end;{rectangl}
{------------------------------------------------------}
procedure shekl1; {*}
begin {draw shekl1} {***}
SetFillStyle(SolidFill, rd);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
bar(xstart+10,ystart+20,xstart+30,ystart+40);
bar(xstart-30,ystart+20,xstart+10,ystart+40);
leftchannel:=xstart-31;
rightchannel:=xstart+31;
end;{shekl1}
{-------------------------------------------------}
procedure shekl2; {*}
begin {darw shekl2} {***}
SetFillStyle(SolidFill, rd);
bar(xstart+10,ystart,xstart+30,ystart+20);
bar(xstart+10,ystart+20,xstart+30,ystart+40);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
bar(xstart-30,ystart+20,xstart-10,ystart+40);
leftchannel:=xstart-31;
rightchannel:=xstart+31;
end;
{------------------------------------------------}
procedure shekl3; {***}
begin {draw shekl3}
SetFillStyle(SolidFill, rd);
bar(xstart+10,ystart,xstart+30,ystart+20);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart-30,ystart,xstart-10,ystart+20);
leftchannel:=xstart-31;
rightchannel:=xstart+31;
end;
{------------------------------------------------}
procedure shekl4; {**}
begin {draw shekl4} {**}
SetFillStyle(SolidFill, rd);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart+10,ystart,xstart+30,ystart+20);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
bar(xstart-30,ystart+20,xstart-10,ystart+40);
leftchannel:=xstart-31;
rightchannel:=xstart+31;
end;
{-------------------------------------------------}
procedure shekl5; {**}
begin {draw shekl5} {**}
SetFillStyle(SolidFill, rd);
bar(xstart+10,ystart,xstart+30,ystart+20);
bar(xstart+10,ystart+20,xstart+30,ystart+40);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
leftchannel:=xstart-11;
rightchannel:=xstart+31;
end;
{-----------------------------------------------------}
procedure ypayan;
begin
if shekl=4 then
yend:=390
else yend:=410;
end;
{------------------------------------------------------}
procedure shekl1__2;
begin {shekl1__2}
SetFillStyle(SolidFill, rd);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
bar(xstart-10,ystart+40,xstart+10,ystart+60);
bar(xstart-30,ystart+20,xstart-10,ystart+40);
leftchannel:=xstart-31;
rightchannel:=xstart+11;
end;
{-------------------------------------------------}
procedure shekl1__3;
begin {shekl1__3}
SetFillStyle(SolidFill, rd);
bar(xstart-30,ystart,xstart-10,ystart+20);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart+10,ystart,xstart+30,ystart+20);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
leftchannel:=xstart-31;
rightchannel:=xstart+31;
end;
{--------------------------------------------------}
procedure shekl1__4;
begin {shekl1__4}
SetFillStyle(SolidFill, rd);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
bar(xstart+10,ystart+40,xstart+30,ystart+60);
bar(xstart+10,ystart+20,xstart+30,ystart+40);
leftchannel:=xstart-11;
rightchannel:=xstart+31;
end;
{---------------------------------------------------------}
procedure shekl2__1;
begin {begin shekl2__1}
SetFillStyle(SolidFill, rd);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart+10,ystart,xstart+30,ystart+20);
bar(xstart+10,ystart+20,xstart+30,ystart+40);
bar(xstart+10,ystart+40,xstart+30,ystart+60);
leftchannel:=xstart-11;
rightchannel:=xstart+31;
end;
{-----------------------------------------------------}
procedure shekl2__2;
begin
SetFillStyle(SolidFill, rd);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
bar(xstart+10,ystart,xstart+30,ystart+20);
bar(xstart+30,ystart,xstart+50,ystart+20);
leftchannel:=xstart-11;
rightchannel:=xstart+51;
end;
{-----------------------------------------------------}
procedure shekl2__3;
begin
SetFillStyle(SolidFill, rd);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
bar(xstart-10,ystart+40,xstart+10,ystart+60);
bar(xstart+10,ystart+20,xstart+30,ystart+40);
leftchannel:=xstart-11;
rightchannel:=xstart+31;
end;
{------------------------------------------------------}
procedure shekl3__1;
begin
SetFillStyle(SolidFill, rd);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
bar(xstart-10,ystart+40,xstart+10,ystart+60);
leftchannel:=xstart-11;
rightchannel:=xstart+11;
end;
{------------------------------------------------------}
procedure shekl4__1;
begin
SetFillStyle(SolidFill, rd);
bar(xstart-10,ystart,xstart+10,ystart+20);
bar(xstart-10,ystart+20,xstart+10,ystart+40);
bar(xstart-10,ystart+40,xstart+10,ystart+60);
bar(xstart+10,ystart+20,xstart+30,ystart+40);
leftchannel:=xstart-11;
rightchannel:=xstart+31;
end;
{------------------------------------------------------}
procedure ashkal;
begin
if shekl = 1 then
begin
case x of
0 : shekl1;
1 : shekl1__2;
2 : shekl1__3;
3 : shekl1__4;
end;
end;
if shekl = 2 then
begin
case x of
0 : shekl2;
1 : shekl2__1;
2 : shekl2__2;
3 : shekl2__3;
end;
if shekl = 3 then
begin
case x of
0,2 : shekl3;
1,3 : shekl3__1;
end;
end;
if shekl = 4 then
begin
case x of
0,2 : shekl4;
1,3 : shekl4__1;
end;
end;
end;
end;
{------------------------------------------------------}
procedure pspace;
begin
x:=x+1;
if x = 4 then x:=0;
ashkal;
end;
procedure arrow;
begin
key:=upcase(key);
keyup:=chr(80);
keydown:=chr(72);
keyleft:=chr(75);
keyright:=chr(77);
space:=chr(32);
if key = keyup then
SetViewPort(470,400, GetMaxX - 20, GetMaxY - 20, ClipOn);
while not keypressed do
begin
outtextxy(470,400,'p a u s e');
end;
if keypressed then
outtextxy(470,400,' ');
if key = keyleft then
begin
lpixel:=getpixel(leftchannel,ystart);
if lpixel <>0 then
xstart:=xstart-20
{ i:=i-1;
if i > 1 then
xstart:=xstart-20;
if i <= 1 then i:=1;}
end;{end key left}
if key = keyright then
begin
rpixel:=getpixel(rightchannel,ystart);
{i:=i+1;
if i<=14 then
xstart:=xstart+20
else
if i >=15 then i:=15;}
if key =space then
pspace;
end;
end;
{------------------------------------------------------}
procedure rising;
begin
while not keypressed do
begin
delay(1000);
rd:=0;
ashkal;
ystart:=ystart+10;
ypayan;
rd:=rd2;
if keypressed then
begin
key:=readkey;
delay(150);
arrow;
end;{end if }
ashkal;
if keypressed then
key:=readkey;
end;
end;{end rising}
{------------------------------------------------------}
begin {main}
driver:= Detect;
initgraph(driver,mode,'..\bgi');
randomize;
{ logo;
music;
readln; }
cleardevice;
rectangl;
tetrix:=true;
for i:=1 to 15 do
for j:=1 to 20 do
matrix[i,j]:=false;
i:=7;
j:=1;
while tetrix = true do
begin{while main}
xstart:=300;
ystart:=50;
rd:=(Random(GetMaxColor)+1);
rd2:=rd;
x:=0;
shekl:=random(5)+1;
delay(600);
rising;
tetrix:=false;
end;
readln;
end.{main}
--------------------------------------------------------------------------------
|
|
|
123
Eng