Programalama > PASCAL

Etiketler: tetris

Ort. 5
Puan ver:
program tetris;
uses crt, graph;
type tablo=Array[1..10,1..29]of integer;
switch= array[1..4,1..6] of integer;

function max(a,b,c: integer):integer;
begin
    if (a>=b)and(a>=c) then max:=a;
    if (b>=a)and(b>=c) then max:=b;
    if (c>=a)and(c>=b) then max:=c;
end;

function min(a,b,c: integer):integer;
begin
   if (a<=b)and(a<=c) then min:=a;
   if (b<=a)and(b<=c) then min:=b;
   if (c<=a)and(c<=b) then min:=c;
end;

function descent(t:tablo;grille:switch; b,c,i: integer):integer;

begin
    while
    (t[grille[b,1]+c,i+1+grille[b,2]]=0)and(t[grille[b,3]+c,i+1+grille[b,4]]=0)and(t[grille[b,5]+c,i+1+grille[b,6]]=0)and
    (t[c,i+1]=0)and(i+grille[b,2]<29)and(i+grille[b,4]<29)and(i+grille[b,6]<29)and(i<29)
    do i:=i+1;
descent:=i;
end;

procedure pause;
var  i,j,k: integer;
begin
    for i:=1 to 2 do begin
        if i=1 then
        setcolor(3)
        else setcolor(0);
    outtextxy(30,20,'..::Tetris::..');
    outtextxy(30,50,'Sola:          4');
    outtextxy(30,70,'Saga:          6');
    outtextxy(30,90,'Degistirme:    5');
    outtextxy(30,110,'Dsrme:       2');
    outtextxy(30,130,'En Sol:        7');
    outtextxy(30,150,'En Sag:        9');
    outtextxy(30,170,'Hizli:         8');
    outtextxy(30,190,'ileri:         N');
    outtextxy(30,210,'Durdur:        P');
    outtextxy(30,230,'Ses:           S');
    outtextxy(30,250,'ilk Engel:     H');
    outtextxy(30,270,'Cikis:         Q');
    if i=1 then begin
            repeat
                for j:=1 to 20  do begin
                    for k:=1 to 2 do begin
                        if k=1 then setcolor(4) else setcolor(0);
                    outtextxy(230+1*j,20,'S');
                    outtextxy(240+2*j,20,'e');
                    outtextxy(250+3*j,20,'r');
                    outtextxy(260+4*j,20,'h');
                    outtextxy(270+5*j,20,'a');
                    outtextxy(280+6*j,20,'t');
                        if k=1 then delay(60);
                    end;
                end;
                for j:=20 downto 1  do begin
                    for k:=1 to 2 do begin
                        if k=1 then setcolor(4) else setcolor(0);
                        outtextxy(230+1*j,20,'S');
                    outtextxy(240+2*j,20,'e');
                    outtextxy(250+3*j,20,'r');
                    outtextxy(260+4*j,20,'h');
                    outtextxy(270+5*j,20,'a');
                    outtextxy(280+6*j,20,'t');
                        if k=1 then delay(60);
                    end;
                end;
            until keypressed;
        end;
    end;
end;

var a,b,c,i,j,k,l,m,n,r,r2,x,v,w,z, ind, i2, nbre, next, lignes, fin, pilote, mode: integer;
t: tablo;
t1,t2,t3,t4,t5,t10,t14,grille: switch;
abscents, presents, test ,son: boolean;
p: longint;
s: string;

begin
t1[1,1]:=0; t1[1,2]:=1; t1[1,3]:=0; t1[1,4]:=-1; t1[1,5]:=1; t1[1,6]:=-1;
t1[2,1]:=1; t1[2,2]:=0; t1[2,3]:=-1; t1[2,4]:=0; t1[2,5]:=-1; t1[2,6]:=-1;
t1[3,1]:=0; t1[3,2]:=1; t1[3,3]:=0; t1[3,4]:=-1; t1[3,5]:=-1; t1[3,6]:=1;
t1[4,1]:=1; t1[4,2]:=0; t1[4,3]:=-1; t1[4,4]:=0; t1[4,5]:=1; t1[4,6]:=1;
t2[1,1]:=1; t2[1,2]:=0; t2[1,3]:=0; t2[1,4]:=-1; t2[1,5]:=-1; t2[1,6]:=-1;
t2[2,1]:=0; t2[2,2]:=-1; t2[2,3]:=-1; t2[2,4]:=0; t2[2,5]:=-1; t2[2,6]:=1;
t3[1,1]:=1; t3[1,2]:=0; t3[1,3]:=-1; t3[1,4]:=0; t3[1,5]:=0; t3[1,6]:=1;
t3[2,1]:=1; t3[2,2]:=0; t3[2,3]:=0; t3[2,4]:=-1; t3[2,5]:=0; t3[2,6]:=1;
t3[3,1]:=0; t3[3,2]:=-1; t3[3,3]:=-1; t3[3,4]:=0; t3[3,5]:=1; t3[3,6]:=0;
t3[4,1]:=0; t3[4,2]:=-1; t3[4,3]:=0; t3[4,4]:=1; t3[4,5]:=-1; t3[4,6]:=0;
t4[1,1]:=0; t4[1,2]:=-1; t4[1,3]:=0; t4[1,4]:=1; t4[1,5]:=0; t4[1,6]:=2;
t4[2,1]:=1; t4[2,2]:=0; t4[2,3]:=2; t4[2,4]:=0; t4[2,5]:=-1; t4[2,6]:=0;
t5[1,1]:=1; t5[1,2]:=0; t5[1,3]:=1; t5[1,4]:=-1; t5[1,5]:=0; t5[1,6]:=-1;
t10[1,1]:=0; t10[1,2]:=-1; t10[1,3]:=0; t10[1,4]:=1; t10[1,5]:=-1; t10[1,6]:=-1;
t10[2,1]:=1; t10[2,2]:=0; t10[2,3]:=-1; t10[2,4]:=0; t10[2,5]:=-1; t10[2,6]:=1;
t10[3,1]:=0; t10[3,2]:=1; t10[3,3]:=0; t10[3,4]:=-1; t10[3,5]:=1; t10[3,6]:=1;
t10[4,1]:=1; t10[4,2]:=0; t10[4,3]:=-1; t10[4,4]:=0; t10[4,5]:=1; t10[4,6]:=-1;
t14[1,1]:=0; t14[1,2]:=-1; t14[1,3]:=1; t14[1,4]:=-1; t14[1,5]:=-1; t14[1,6]:=0;
t14[2,1]:=0; t14[2,2]:=1; t14[2,3]:=-1; t14[2,4]:=0; t14[2,5]:=-1; t14[2,6]:=-1;

    for i:=1 to 10 do begin
        for j:=1 to 29 do
        t[i,j]:=0;
    end;

pilote:=detect;
initGraph(pilote,mode,'c:\tp\bgi');
clearviewport;
setcolor(8);
setbkcolor(black);
    for j:=1 to 30 do
    line(220,j*15+20,420,j*15+20);
    for i:=1 to 11 do
    line(i*20+200,35,i*20+200,470);
setcolor(3);
outtextxy(450,30,'Puan:');
outtextxy(450,50,'Satir:');
outtextxy(450,70,'Bolum:  1');
outtextxy(450,100,'Yardim: I');
outtextxy(450,140,'Bidahaki:');
setcolor(8);
rectangle(465,160,535,230);

p:=0;
lignes:=0;
n:=1;
ind:=0;
son:=true;
next:=0;

r2:=random(7)+1;
    repeat
    r:=r2;
    randomize;
    m:=0;
    i:=1;
    x:=310;
    c:=5;
    b:=1;

    r2:=random(7)+1;
        if r2=7 then r2:=14;
        if r2=6 then r2:=10;
        if r2=1 then grille:=t1;
        if r2=2 then grille:=t2;
        if r2=3 then grille:=t3;
        if r2=4 then grille:=t4;
        if r2=5 then grille:=t5;
        if r2=10 then grille:=t10;
        if r2=14 then grille:=t14;


     if next=1 then begin
     setfillstyle(1,0);
     floodfill(500,190,8);
     setcolor(r2);
     rectangle(490,180,510,195);
     rectangle(490+grille[1,1]*20,180+grille[1,2]*15,510+grille[1,1]*20,195+grille[1,2]*15);
     rectangle(490+grille[1,3]*20,180+grille[1,4]*15,510+grille[1,3]*20,195+grille[1,4]*15);
     rectangle(490+grille[1,5]*20,180+grille[1,6]*15,510+grille[1,5]*20,195+grille[1,6]*15);
     end;

        if r=1 then grille:=t1;
        if r=2 then grille:=t2;
        if r=3 then grille:=t3;
        if r=4 then grille:=t4;
        if r=5 then grille:=t5;
        if r=10 then grille:=t10;
        if r=14 then grille:=t14;

        repeat
        z:=0;
            if i<>1 then begin
            setfillstyle(1,0);
            floodfill(x,i*15+25,8);
            floodfill(grille[b,1]*20+x,(i+grille[b,2])*15+25,8);
            floodfill(grille[b,3]*20+x,(i+grille[b,4])*15+25,8);
            floodfill(grille[b,5]*20+x,(i+grille[b,6])*15+25,8);
            end;

        i:=i+1;
            while keypressed do begin
            z:=ord(readkey)-ord('0');
            v:=min(grille[b,1],grille[b,3],grille[b,5]);
            w:=max(grille[b,1],grille[b,3],grille[b,5]);

                if (z=4)and(c+v>1)and(t[c+grille[b,1]-1,i+grille[b,2]]=0)
                and(t[c+grille[b,3]-1,i+grille[b,4]]=0)and(t[c+grille[b,5]-1,i+grille[b,6]]=0) then begin x:=x-20; c:=c-1; end;

                if (z=6)and(c+w<10)and(t[c+grille[b,1]+1,i+grille[b,2]]=0)
                and(t[c+grille[b,3]+1,i+grille[b,4]]=0)and(t[c+grille[b,5]+1,i+grille[b,6]]=0) then begin x:=x+20; c:=c+1; end;

                if z=7 then begin
                    while (c+v>1)and(t[c+grille[b,1]-1,i+grille[b,2]]=0)
                    and(t[c+grille[b,3]-1,i+grille[b,4]]=0)and(t[c+grille[b,5]-1,i+grille[b,6]]=0) do begin x:=x-20;c:=c-1;end;
                end;

                if z=9 then begin
                    while (c+w<10)and(t[c+grille[b,1]+1,i+grille[b,2]]=0)
                    and(t[c+grille[b,3]+1,i+grille[b,4]]=0)and(t[c+grille[b,5]+1,i+grille[b,6]]=0) do begin x:=x+20;c:=c+1;end;
                end;

                if z=2 then begin
                i2:=i;
                i:=descent(t,grille,b,c,i);
                setcolor(0);
                str(p,s);
                outtextxy(514,30,s);
                p:=p+(i-i2)*SQR(n) div 4;
                setcolor(3);
                str(p,s);
                outtextxy(514,30,s);
                end;

                if z=5 then begin
                a:=1;
                    if (r=2)or(r=14)or(r=4) then a:=2;
                    if (r=1)or(r=10)or(r=3) then a:=4;
                v:=min(grille[(b mod a)+1,1],grille[(b mod a)+1,3],grille[(b mod a)+1,5]);
                w:=max(grille[(b mod a)+1,1],grille[(b mod a)+1,3],grille[(b mod a)+1,5]);

                    if (c+v>0)and(c+w<11)and(t[c+grille[(b mod a)+1,1],i+grille[(b mod a)+1,2]]=0)
         and(t[c+grille[(b mod a)+1,3],i+grille[(b mod a)+1,4]]=0)and(t[c+grille[(b mod a)+1,5],i+grille[(b mod a)+1,6]]=0)
                    then begin
                    m:=m+1;
                    b:=(m mod a)+1;
                    end;
                end;

                if (z=8)or(ind=1) then begin
                ind:=0;
                setcolor(0);
                str(n,s);
                outtextxy(514,70,s);
                n:=n+1;
                setcolor(3);
                str(n,s);
                outtextxy(514,70,s);
                end;

                if z=ord('q')-ord('0') then halt(1);

                if (z=ord('s')-ord('0'))or((z=ord('S')-ord('0'))) then
                    if son=true then son:=false else son:=true;

                if (z=ord('p')-ord('0'))or(z=ord('P')-ord('0')) then begin
                    repeat
                        for j:=1 to 25  do begin
                            for k:=1 to 2 do begin
                                if k=1 then setcolor(4) else setcolor(0);
                            outtextxy(295-3*j,20,'D');
                            outtextxy(305-j,20,'u');
                            outtextxy(315,20,'r');
                            outtextxy(325+j,20,'d');
                            outtextxy(335+3*j,20,'u');
                                if k=1 then delay(50);
                            end;
                        end;
                        for j:=25 downto 1  do begin
                            for k:=1 to 2 do begin
                                if (k=1) then setcolor(4) else setcolor(0);
                            outtextxy(295-3*j,20,'D');
                            outtextxy(305-j,20,'u');
                            outtextxy(315,20,'r');
                            outtextxy(325+j,20,'d');
                            outtextxy(335+3*j,20,'u');
                                if k=1 then delay(50);
                            end;
                        end;
                    until keypressed;
                end;

                if (z=ord('n')-ord('0'))or(z=ord('N')-ord('0')) then begin
                    if next=1 then begin
                    next:=0;
                    floodfill(500,190,8);
                    end else
                    next:=1;
                end;

                if (z=ord('h')-ord('0'))and(p=0) then begin
                    setcolor(3);
                    outtextxy(450,250,'Hauteur ?');
                    repeat
                        repeat until keypressed;
                    z:=ord(readkey)-ord('0');
                    until (z>=0)and(z<10);
                setcolor(0);
                outtextxy(450,250,'Height ?');
                setfillstyle(1,9);
                     for j:=29 downto 30-z do begin
                         for k:=1 to 10 do begin
                             if (random(2)=1)or(k=30-j) then begin
                             t[k,j]:=9;
                             floodfill(k*20+210,j*15+25,8);
                             end;
                         end;
                     end;
                end;
                if (z=ord('i')-ord('0'))or(z=ord('I')-ord('0')) then
                pause;
            end;

        setfillstyle(1,r);
        floodfill(x,i*15+25,8);
        floodfill(grille[b,1]*20+x,(i+grille[b,2])*15+25,8);
        floodfill(grille[b,3]*20+x,(i+grille[b,4])*15+25,8);
        floodfill(grille[b,5]*20+x,(i+grille[b,6])*15+25,8);

        delay(Round(600/(exp(0.7*ln(n)))));
        fin:=descent(t,grille,b,c,i);
        until (z=2)or(fin=i);

    setcolor(0);
    str(p,s);
    outtextxy(514,30,s);
    p:=p+7*n+50*(1-next);
    setcolor(3);
    str(p,s);
    outtextxy(514,30,s);

    t[c,i]:=r;
    t[c+grille[b,1],i+grille[b,2]]:=r;
    t[c+grille[b,3],i+grille[b,4]]:=r;
    t[c+grille[b,5],i+grille[b,6]]:=r;

    {Suppress of full lines}
    i:=30;
    nbre:=0;
        repeat
        i:=i-1;
        abscents:=true;
        presents:=true;
            for j:=1 to 10 do begin
                if t[j,i]<>0 then abscents:=false;
                if t[j,i]=0 then presents:=false;
            end;

            if presents=true then begin
            nbre:=nbre+1;
            setcolor(0);
            str(lignes,s);
            outtextxy(514,50,s);
            lignes:=lignes+1;
            setcolor(3);
            str(lignes,s);
            outtextxy(514,50,s);

                if lignes=10*(n+1) then begin
                    ind:=1;
                    if son=true then begin
                        for a:=100 to 1500 do begin
                        sound(a);
                        delay(1);
                        end;
                    nosound;
                    end;
                end else begin
                    if son=true then begin
                    sound(440*nbre);
                    end;
                end;

                for j:=1 to 10 do begin
                setfillstyle(1,0);
                floodfill(j*20+210,i*15+25,8);
                delay(round(100/n));
                end;
                for j:=1 to 10 do begin
                    for k:=i downto 1 do begin
                        if k>1 then begin
                        t[j,k]:=t[j,k-1];
                        setfillstyle(1,t[j,k-1]);
                        floodfill(j*20+210,k*15+25,8);
                        end else
                        t[j,1]:=0;
                    end;
                end;
            i:=i+1;
            nosound;
            end;
        until (abscents)or(i=1);

    test:=false;
        for j:=1 to 10 do
            if t[j,1]<>0 then test:=true;

    until test;
    if son=true then begin
        for a:=1500 downto 100 do begin
        sound(a);
        delay(1);
        end;
    nosound;
    end;
    repeat
        for j:=1 to 25  do begin
            for k:=1 to 2 do begin
                    if k=1 then setcolor(4) else setcolor(0);
                outtextxy(290-3*j,20,'B');
                            outtextxy(300-j,20,'i');
                            outtextxy(310,20,'t');
                            outtextxy(320+j,20,'t');
                            outtextxy(330+3*j,20,'i');
                    if k=1 then delay(50);
            end;
        end;
        for j:=25 downto 1  do begin
            for k:=1 to 2 do begin
                if (k=1) then setcolor(4) else setcolor(0);
            outtextxy(290-3*j,20,'B');
                            outtextxy(300-j,20,'i');
                            outtextxy(310,20,'t');
                            outtextxy(320+j,20,'t');
                            outtextxy(330+3*j,20,'i');
                if k=1 then delay(50);
            end;
        end;
    until keypressed;
       repeat until keypressed;
end.


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2017 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSObil projesidir.