Паскаль графика(ООП)

program spliner_1;
uses crt,graph,TETRIS;
var
 
ch:figure;
cd:tet;
field : array[ - 5..20, - 5..30 ] of boolean;
b,block, nextblock : figure;
 d, m, i,h, j, k, x, y, time, count, score, level, next : integer;
a : char;                {
newgame,gamover:integer;}
label newgame,gamover;
begin
with cd do begin
gameinterface;
build(  k,b);
updatescore;
drawfield;
delblock;
delline( h  );
drawblock;
move( m );
movedown;
rotate( k  );
pause;
 
    detectgraph( d, m );
    initgraph( d, m, '' );
    gameinterface;
    newgame : score:=0 ;
    level := 1;
    updatescore;
    setfillstyle( solidfill, black );
    bar( 11, 1, 160, 260 );
    x := 6;
    y := 0;
    randomize;
    k := random( 7 ) + 1;
    build( k, block );
    for i := 1 to 15 do
    for j := 1 to 25 do
        field[ i, j ] := false;
    next := random( 7 ) + 1;
    build( next, nextblock );
    drawfield;
    repeat
        if count= 0 then time := 40 - 3 * level;
        for i := 1 to 15 - level do
        begin
            if keypressed then
            begin
                a := readkey;
                if a = #0 then a := readkey;
                case a of
                    #75 : move( - 1 );
                    #77 : move( 1 );
                    #72 : rotate( k );
                    #80 :
                    begin
                        count := count + 2 *( 15 - level );
                        time := 0
                    end;
                    #60 : goto newgame;
                    #61 : pause;
                end;
            end;
            while keypressed do
                readkey;
            delay( time );
            if count > 0 then dec( count );
        end;
        movedown;
       if k = 8 then goto gamover;
    until( a = #27 );
    exit;
    gamover : moveto( 50, 60 );
    outtext( 'Game Over!' );
    repeat
        a := readkey;
    until( a = #60 ) or( a = #27 );
    if a = #60 then goto newgame;
 
 repeat
        if count = 0 then time := 40 - 3 * level;
        for i := 1 to 15 - level do
        begin
            if keypressed then
            begin
                a := readkey;
                if a = #0 then a := readkey;
                case a of
                    #75 : move( - 1 );
                    #77 : move( 1 );
                    #72 : rotate( k );
                    #80 :
                    begin
                        count := count + 2 *( 15 - level );
                        time := 0
                    end;
                    #60 : goto newgame;
                    #61 : pause;
                end;
            end;
            while keypressed do
                readkey;
            delay( time );
            if count > 0 then dec( count );
        end;
        movedown;
        if k = 8 then goto gamover;
    until( a = #27 );
    exit;
    {gamovers : moveto( 50, 60 );}
    outtext( 'Game Over!' );
    repeat
        a := readkey;
    until( a = #60 ) or( a = #27 );
    if a = #60 then goto newgame;
 
repeat
        if count = 0 then time := 40 - 3 * level;
        for i := 1 to 15 - level do
        begin
            if keypressed then
            begin
                a := readkey;
                if a = #0 then a := readkey;
                case a of
                    #75 : move(-1 );
                    #77 : move( 1 );
                    #72 : rotate( k );
                    #80 :
                    begin
                        count := count + 2 *( 15 - level );
                        time := 0
                    end;
                    #60 : goto newgame;
                    #61 : pause;
                end;
            end;
            while keypressed do
                readkey;
            delay( time );
            if count > 0 then dec( count );
        end;
        movedown;
        if k = 8 then goto gamover;
    until( a = #27 );
    exit;
    {gamover : moveto( 50, 60 );}
    outtext( 'Game Over!' );
    repeat
        a := readkey;
    until( a = #60 ) or( a = #27 );
    if a = #60 then goto newgame;
 
end;
repeat until keypressed;
end.

unit tetris;
interface
uses graph,crt;
type figure = array[ 1..4, 1..4 ] of boolean;
const size : array[ 1..7 ] of integer =( 2, 4, 3, 3, 3, 3, 3 );
 
 { type figure = array[ 1..4, 1..4 ] of boolean; }
type tet =object
 
 
field : array[ - 5..20, - 5..30 ] of boolean;
block, nextblock : figure;
 {d,} {m,} {i,} {j,}{ k,} x, y, time, count, score, level, next : integer;
a : char;
procedure gameinterface;
procedure build( k : integer; var b : figure );
procedure updatescore;
procedure drawfield;
procedure delblock;
procedure delline( h : integer );
procedure drawblock;
procedure move( m : integer );
procedure movedown;
procedure rotate( k : integer );
procedure pause;
end;
implementation
{label newgame, gamover;  }
procedure tet.gameinterface;
begin
    clearviewport;
    setfillstyle( solidfill, green );
    bar( 1, 1, 170, 270 );
    moveto( 200, 10 );
    outtext( 'Tetris by Spl1NeR' );
    moveto( 200, 40 );
    outtext( 'Controls:' );
    moveto( 220, 55 );
    outtext( 'Left & Right Arrows - Move left or right' );
    moveto( 220, 70 );
    outtext( 'Down Arrow - Accelerate down' );
    moveto( 220, 85 );
    outtext( 'Up Arrow - Rotate' );
    moveto( 220, 100 );
    outtext( 'F2 - New game' );
    moveto( 220, 115 );
    outtext( 'F3 - Pause' );
    moveto( 220, 130 );
    outtext( 'Esc - Exit' );
    moveto( 200, 200 );
    outtext( 'Next:' );
    moveto( 200, 250 );
    outtext( 'Score:' );
    moveto( 200, 270 );
    outtext( 'Level:' );
end;{}
 
procedure tet.build( k : integer; var b : figure );
var i, j : integer;
begin
    for i := 1 to 4 do
    for j := 1 to 4 do
        b[ i, j ] := false;
    case k of
        1 :
        begin
            for i := 1 to 2 do
            for j := 1 to 2 do
                b[ i, j ] := true;
        end;
        2 :
        begin
            for j := 1 to 4 do
                b[ 2, j ] := true;
        end;
        3 :
        begin
            b[ 1, 1 ] := true;
            for i := 1 to 3 do
                b[ i, 2 ] := true;
        end;
        4 :
        begin
            b[ 1, 3 ] := true;
            for i := 1 to 3 do
                b[ i, 2 ] := true;
        end;
        5 :
        begin
            for i := 1 to 2 do
            begin
                b[ i + 1, 1 ] := true;
                b[ i, 2 ] := true
            end;
        end;
        6 :
        begin
            for i := 1 to 2 do
            begin
                b[ i + 1, 2 ] := true;
                b[ i, 1 ] := true
            end;
        end;
        7 :
        begin
            for i := 1 to 3 do
                b[ i, 2 ] := true;
            b[ 2, 1 ] := true;
        end;
    end;
end;
 
procedure tet.updatescore;
var s : string;
begin
    setfillstyle( solidfill, black );
    bar( 245, 245, 300, 260 );
    str( score, s );
    moveto( 250, 250 );
    outtext( s );
    setfillstyle( solidfill, black );
    bar( 245, 265, 300, 280 );
    str( level, s );
    moveto( 250, 270 );
    outtext( s );
end;
 
procedure tet.drawfield;
var i, j : integer;
begin
    setfillstyle( solidfill, black );
    bar( 11, 1, 160, 260 );
    for i := 1 to 15 do
    for j := 1 to 25 do
    if field[ i, j ] then
    begin
        setfillstyle( solidfill, red );
        bar( 10 * i + 1, 10 * j + 1, 10 *( i + 1 ), 10 *( j + 1 ) );
        setfillstyle( solidfill, black );
        bar( 10 * i + 3, 10 * j + 3, 10 *( i + 1 ) - 2, 10 *( j + 1 ) - 2 );
    end;
    setfillstyle( solidfill, black );
    bar( 250, 180, 300, 230 );
    for i := 1 to size[ next ] do
    for j := 1 to size[ next ] do
    if nextblock[ i, j ] then
    begin
        setfillstyle( solidfill, green );
        bar( 10 * i + 251, 10 * j + 181, 10 *( i + 1 ) + 250, 10 *( j + 1 ) + 180 );
        setfillstyle( solidfill, blue );
        bar( 10 * i + 253, 10 * j + 183, 10 *( i + 1 ) + 248, 10 *( j + 1 ) + 178 );
    end;
end;
 
procedure tet.delblock;
var i, j ,k{}: integer;
begin
    setfillstyle( solidfill, black );
    for i := 1 to size[ k ] do
    for j := 1 to size[ k ] do
    if block[ i, j ] then bar( 10 * x + 10 * i + 1, 10 * y + 10 * j + 1,
                               10 * x + 10 *( i + 1 ), 10 * y + 10 *( j + 1 ) );
end;
 
procedure tet.delline( h : integer );
var i, j, k, c : integer;
begin
    c := 0;
    for j := h to h + 3 do
    begin
        if j > 25 then break;
        i := 1;
        while( field[ i, j ] ) and( i < 15 ) do
            inc( i );
        if( field[ i, j ] ) and( i = 15 ) then
        begin
            inc( c );
            for i := 1 to 15 do
            for k := j downto 2 do
                field[ i, k ] := field[ i, k - 1 ];
        end;
    end;
    drawfield;
    score := score + c * c+random(5);
    if( score >= 50 * level ) and( level < 10 ) then inc( level );
    updatescore;
end;
 
procedure tet.drawblock;
var i, j,k{} : integer;
begin
    for i := 1 to size[ k ] do
    for j := 1 to size[ k ] do
    if block[ i, j ] then
    begin
        setfillstyle( solidfill, green );
        bar( 10 * x + 10 * i + 1, 10 * y + 10 * j + 1,
             10 * x + 10 *( i + 1 ), 10 * y + 10 *( j + 1 ) );
        setfillstyle( solidfill, blue );
        bar( 10 * x + 10 * i + 3, 10 * y + 10 * j + 3,
             10 * x + 10 *( i + 1 ) - 2, 10 * y + 10 *( j + 1 ) - 2 );
    end;
end;
 
procedure tet.move( m : integer );
var i, j,k{} : integer;
begin
    for i := 1 to size[ k ] do
    for j := 1 to size[ k ] do
    if( block[ i, j ] ) and(( i + x + m > 15 ) or( i + x + m < 1 )
    or( field[ x + i + m, y + j ] ) ) then exit;
    delblock;
    if m = 1 then inc( x ) else dec( x );
    drawblock;
end;
 
procedure tet.movedown;
var i, j, i1, j1,k{} : integer;
begin
    for i := 1 to size[ k ] do
    for j := 1 to size[ k ] do
    if( block[ i, j ] ) and(( field[ i + x, j + 1 + y ] ) or( j + y >= 25 ) ) then
    begin
        if y = 0 then for i1 := 1 to size[ k ] do
        if block[ i1, 1 ] then
        begin
            k := 8;
            exit
        end;
        for i1 := 1 to size[ k ] do
        for j1 := 1 to size[ k ] do
        if block[ i1, j1 ] then field[ i1 + x, j1 + y ] := true;
        block := nextblock;
        k := next;
        next := random( 7 ) + 1;
        build( next, nextblock );
        delline( y + 1 );
        x := 6;
        y := 0;
        exit;
    end;
    delblock;
    inc( y );
    drawblock;
end;
 
procedure tet.rotate( k : integer );
var block1 : figure;
i, j : integer;
begin
    delblock;
    for i := 1 to 4 do
    for j := 1 to 4 do
        block1[ i, j ] := false;
    if k = 2 then
    begin
        if block[ 2, 1 ] then
        begin
            for i := 1 to 4 do
            begin
                block1[ i, 2 ] := true;
                if( field[ i + x, 2 + y ] ) or( i + x > 15 ) or( i + x < 1 )
                                            or( 2 + y > 25 ) or( 2 + y < 1 ) then
                begin
                    drawblock;
                    exit;
                end;
            end;
            block := block1;
        end
        else
        begin
            for i := 1 to 4 do
                block1[ 2, i ] := true;
                   block := block1;
        end;
    end
    else if k > 2 then
    begin
        for i := 1 to 3 do
        for j := 1 to 3 do
        if block[ 4 - j, i ] then
        begin
            block1[ i, j ] := block[ 4 - j, i ];
            if(( field[ i + x, j + y ] ) or( i + x > 15 ) or( i + x < 1 ) or( j + y > 25 )
                                         or( j + y < 1 ) ) and( block1[ i, j ] ) then
            begin
                drawblock;
                exit
            end;
        end;
        block := block1;
    end;
    drawblock;
end;
 
 
procedure tet.pause;
var d,m:integer;
begin
    clearviewport;
    moveto( 230, 60 );
    outtext( 'The game is paused' );
    moveto( 150, 90 );
    outtext( 'Press F3 to continue or press Esc to exit' );
    repeat
       a := readkey;
    until( a = #61 ) or( a = #27 );
    if a = #27 then halt;
    gameinterface;
    drawfield;
    drawblock;
    updatescore;
end;
 
 
 
 
end.