Розробка інформаційного та програмного забезпечення для реалізації гри "Тетріс"

Мал. 6.1 Вікно програми

Мал. 6.2 Введення імені

7. Лістинг програми

program main;

uses tetobj,game,crt,graph,ramki,int;

var bl:tblock;f:tfield;

score:integer;

s:string;

procedure myinitgraph;

var gd,gm:integer;

begin

gd:=detect;

initgraph(gd,gm,'c:/bp/bgi');

if graphresult<>0 then

begin writeln('Graphic Error');readkey;halt end;

end;

begin

release(heaporg);

randomize;

myinitgraph;

repeat startgame(bl,f,score) until 1=2;

entername(score,s);

closegraph;

end.

unit TetObj;

interface

uses crt,graph;

const maxX:byte=20;

maxY:byte=30;

size:byte=12;

level:byte=1;

speed:real=0.4;

type TMatrixField=array[0..31,1..45]of 0..1;

TMatrixBlock=array[1..4,1..4]of 0..1;

TBlock=object

mx,my,x,y:byte;

matr:TmatrixBlock;

t:byte;

pos:1..4;

p,p2:pointer;

s,s2:word;

procedure initmatrix;

constructor init;

constructor init2(t1,pos1:byte);

procedure rotate;virtual;

procedure draw;virtual;

procedure clear;virtual;

destructor done;

end;

Tfield=object

x1,y1:integer;

matr:TMatrixField;

constructor init(level:byte);

procedure draw;

procedure clear;

function full:boolean;

function fline (n:byte):boolean;

procedure dline (n:byte);

private

x2,y2:integer;

end;

implementation

constructor tfield.init;

var i,j:byte;

begin

for i:=1 to maxX do

for j:=1 to maxY do

matr[i,j]:=0;

for i:=0 to maxX+1 do

matr[i,maxY+1]:=1;

for j:=1 to maxY do begin

matr[0,j]:=1;

matr[maxX+1,j]:=1;

end;

randomize;

for i:=1 to level-1 do

for j:=1 to MaxX div 2 do

matr[random(maxX-2)+1,maxY-i+1]:=1;

x1:=20;y1:=40;

x2:=size*maxX;

y2:=size*maxY;

setviewport(x1,y1,x1+x2,y1+y2,true);

end;

procedure tblock.initmatrix;

var i,j:byte;

begin

for i:=1 to 4 do

for j:=1 to 4 do

matr[i,j]:=0;

case t of

1:case pos of

1,3: begin

mx:=4;

my:=1;

for j:=1 to mx do matr[j,1]:=1;

end;

2,4: begin

mx:=1;

my:=4;

for j:=1 to my do

matr[1,j]:=1;

end;

end;

2: case pos of

1,3: begin

mx:=3;

my:=2;

matr[1,1]:=1;

matr[2,1]:=1;

matr[2,2]:=1;

matr[3,2]:=1;

end;

2,4: begin

mx:=2;

my:=3;

matr[1,2]:=1;

matr[1,3]:=1;

matr[2,1]:=1;

matr[2,2]:=1;

end;

end;

3: case pos of

1: begin

mx:=3;

my:=2;

matr[2,1]:=1;

matr[1,2]:=1;

matr[2,2]:=1;

matr[3,2]:=1;

end;

2: begin

mx:=2;

my:=3;

matr[1,1]:=1;

matr[1,2]:=1;

matr[1,3]:=1;

matr[2,2]:=1;

end;

3: begin

mx:=3;

my:=2;

matr[2,2]:=1;

matr[1,1]:=1;

matr[2,1]:=1;

matr[3,1]:=1;

end;

4: begin

mx:=2;

my:=3;

matr[2,1]:=1;

matr[2,2]:=1;

matr[2,3]:=1;

matr[1,2]:=1;

end;

end;

4: case pos of

1,3: begin

mx:=3;

my:=2;

matr[2,1]:=1;

matr[3,1]:=1;

matr[1,2]:=1;

matr[2,2]:=1;

end;

2,4: begin

mx:=2;

my:=3;

matr[1,1]:=1;

matr[1,2]:=1;

matr[2,2]:=1;

matr[2,3]:=1;

end;

end;

5: begin

mx:=2;

my:=2;

for i:=1 to 2 do

for j:=1 to 2 do

matr[i,j]:=1;

end;

6: case pos of

1: begin

mx:=2;

my:=3;

matr[2,1]:=1;

matr[2,2]:=1;

matr[2,3]:=1;

matr[1,3]:=1;

end;

2: begin

mx:=3;

my:=2;

matr[1,1]:=1;

matr[2,1]:=1;

matr[3,1]:=1;

matr[3,2]:=1;

end;

3: begin

mx:=2;

my:=3;

matr[1,1]:=1;

matr[1,2]:=1;

matr[1,3]:=1;

matr[2,1]:=1;

end;

4: begin

mx:=3;

my:=2;

matr[1,1]:=1;

matr[1,2]:=1;

matr[2,2]:=1;

matr[3,2]:=1;

end;

end;

7: case pos of

1: begin

mx:=2;

my:=3;

matr[1,1]:=1;

matr[1,2]:=1;

matr[1,3]:=1;

matr[2,3]:=1;

end;

2: begin

mx:=3;

my:=2;

matr[1,2]:=1;

matr[2,2]:=1;

matr[3,2]:=1;

matr[3,1]:=1;

end;

3: begin

mx:=2;

my:=3;

matr[2,1]:=1;

matr[2,2]:=1;

matr[2,3]:=1;

matr[1,1]:=1;

end;

4: begin

mx:=3;

my:=2;

matr[1,2]:=1;

matr[1,1]:=1;

matr[2,1]:=1;

matr[3,1]:=1;

end;

end;

end;

end;

procedure kv ( var p: pointer;VAR s:word );

var p2:pointer;

S2:WORD;

begin

s:=imagesize(0,0,size,size);

getmem(p2,s);

getimage(0,0,size,size,p2^);

setfillstyle(1,4);

setcolor(12);

bar(0,0,size,size);

rectangle(2,2,size-1,size-2);

getmem(p,s);

getimage(0,0,size,size,p^);

putimage(0,0,p2^,normalput);

freemem(p2,s);

p2:=nil;

end;

constructor tblock.init;

var x1,y1,x2,y2,i,j:integer;

begin

randomize;

t:=random(100)mod 7 +1;

pos:=random(3)+1;

initmatrix;

x:=(maxX-mx) div 2;

y:=2;

kv(p,s);

p2:=nil;

end;

constructor tblock.init2;

begin

t:=t1;

pos:=pos1;

initmatrix;

x:=(maxX-mx) div 2;

y:=2;

kv(p,s);

p2:=nil;

end;

procedure tblock.draw;

var i,j:byte;

begin

s2:=imagesize(0,0,mx*size,my*size);

getmem(p2,s2);

getimage((x-1)*size,(y-1)*size,(x-1+mx)*size,

(y-1+my)*size,p2^);

for i:=1 to mx do

for j:=1 to my do

if matr[i,j]<>0 then putimage((x+i-2)*size,

(y+j-2)*size,p^,normalput);

end;

procedure tblock.clear;

var x1,x2,y1,y2:integer;

begin

putimage((x-1)*size,(y-1)*size,p2^,normalput);

freemem(p2,s2);

p2:=nil;

end;

procedure tblock.rotate;

begin

if pos<4 then inc(pos)else pos:=1;

x:=x+((mx+1) div 2);

y:=y+((my+1) div 2);

x:=x-((mx+1) div 2);

y:=y-((my+1) div 2);

initmatrix;

end;

procedure tfield.draw;

var i,j:byte;

p:pointer;

s,r,a,b:word;

col:word;

ar:array [1..5,1..4]of word;

begin

setfillstyle(1,blue);

bar(0,0,x2,y2);

setcolor(3);

for i:=1 to maxX-1 do

line(size*i,0,size*i,y2);

for i:=1 to maxY-1 do

line(0,size*i,x2,size*i);

ar[1,1]:=75*maxX*size div 100+4;

ar[1,2]:=35*maxY*size div 150-4;

ar[1,3]:=12;

ar[1,4]:=MaxX*size div 6;

ar[2,1]:=7*maxX*size div 10+3;

ar[2,2]:=75*maxY*size div 150-2;

ar[2,3]:=14;

ar[2,4]:=MaxX*size div 8;

ar[3,1]:=3*maxX*size div 10-6;

ar[3,2]:=1*maxY*size div 10-4;

ar[3,3]:=13;

ar[3,4]:=MaxX*size div 10;

for i:=1 to 3 do begin

setcolor(ar[i,3]);

a:=ar[i,1];b:=ar[i,2];

r:=ar[i,4];

{1}line(a,b,a+(r*3 div 10) ,b-(r*95)div 100);

line(a-(r*3 div 10) ,b-(r*95)div 100,a,b);

line(a+(r*3 div 10),b-(r*95)div 100,a-(r*3 div 10),

b-(r*95)div 100);

{2}line(a,b,a+(r*3 div 10) ,b+(r*95)div 100);

line(a-(r*3 div 10) ,b+(r*95)div 100,a,b);

line(a-(r*3 div 10),b+(r*95)div 100,a+(r*3 div 10),

b+(r*95)div 100);

{3}line(a,b,a-(r*95)div 100,b+(r*3 div 10));

line(a-(r*95)div 100,b-(r*3 div 10),a,b);

line(a-(r*95)div 100,b-(r*3 div 10),a-(r*95)div 100,

b+(r*3 div 10));

{4}line(a,b,a+(r*95)div 100,b+(r*3 div 10));

line(a+(r*95)div 100,b-(r*3 div 10),a,b);

line(a+(r*95)div 100,b-(r*3 div 10),a+(r*95)div 100,

b+(r*3 div 10));

{5}line(a+(45*r)div 100,b-(88*r)div 100,a,b);

line(a+(88*r)div 100,b-(45*r)div 100,a,b);

line(a+(45*r)div 100,b-(88*r)div 100,a+(88*r)div 100,

b-(45*r)div 100);

{6}line(a-(45*r)div 100,b-(88*r)div 100,a,b);

line(a-(88*r)div 100,b-(45*r)div 100,a,b);

line(a-(45*r)div 100,b-(88*r)div 100,a-(88*r)div 100,

b-(45*r)div 100);

{7}line(a-(45*r)div 100,b+(88*r)div 100,a,b);

line(a-(88*r)div 100,b+(45*r)div 100,a,b);

line(a-(45*r)div 100,b+(88*r)div 100,a-(88*r)div 100,

b+(45*r)div 100);

{8}line(a+(45*r)div 100,b+(88*r)div 100,a,b);

line(a+(88*r)div 100,b+(45*r)div 100,a,b);

line(a+(45*r)div 100,b+(88*r)div 100,a+(88*r)div 100,

b+(45*r)div 100);

end;

kv( p,s );

for i:=1 to maxX do

for j:=1 to maxY do

if matr [i,j] = 1 then putimage( (i-1)*size,

(j-1)*size,p^,normalput );

freemem( p,s );

p:=nil;

end;

procedure tfield.clear;

begin

setviewport(x1,y1,x1+x2,y1+y2,true);

setfillstyle(1,0);

bar(0,0,x2,y2)

end;

function tfield.full;

var i:byte;

begin

full:=false;

for i:=1 to maxX do

if matr[i,2]<>0 then full:=true ;

end;

function tfield.fline;

var i:byte;

t:boolean;

begin

t:=true;

for i:=1 to maxX do

if matr[i,n]=0 then t:=false;

fline:=t;

end;

procedure tfield.dline;

var i,j:byte;

pr:^pointer;

sz:word;

begin

for j:=n downto 2 do

for i:=1 to maxX do

matr[i,j]:=matr[i,j-1]

end;

destructor tblock.done;

begin

if p<>nil then freemem (p,s);

if p2<>nil then freemem (p2,s2 );

p:=nil;

p2:=nil;

end;

begin

end.

unit ramki;

interface

uses graph,crt;

type menutype=array[1..10]of string[15];

tramka=object

x,y,width,heigth:integer;

lighted:boolean;

col1,col2,col3:integer;

private

p:pointer;

s:word;

public

constructor init( x1, y1, xx , yy :word);

procedure mkactive;

procedure light;

procedure unlight;

procedure draw;

procedure clear;

destructor done;

end;

tsubmenu=object(tramka)

punkts:menutype;

n:byte;

col4:integer;

constructor init(const pnk:menutype;n1:byte;x1,y1:word);

procedure draw;

function result:byte;

private h:integer;

end;

tmainmenu=object(tsubmenu)

constructor init(const pnk:menutype;n1:byte);

procedure draw;

function result:byte;

procedure getkoords(i:byte;var xI,yI:word);

end;

implementation

constructor tramka.init;

begin

x:=x1;

y:=y1;

width:=xx;

heigth:=yy;

lighted:=false;

col1:=2;

col2:=4;

col3:=14;

end;

procedure tramka.mkactive;

begin

setviewport( x,y,x+width, y+heigth ,true);

end;

procedure tramka.light;

begin

if not lighted then begin

mkactive;

setcolor(red);

setlinestyle(0,$11,1);

rectangle(1,1,width-1,heigth-1) ;

lighted:=true;

end;

end;

procedure tramka.unlight;

begin

if lighted then begin

mkactive;

setcolor(14);

setlinestyle(0,$11,1);

rectangle(1,1,width-1,heigth-1) ;

lighted:=false;

end;

end;

procedure tramka.draw;

begin

mkactive;

s:=imagesize( 0,0,width ,heigth );

getmem( p,s);

getimage( 0,0,width,heigth,p^ );

setfillstyle(1,green);

bar( 0,0,width,heigth );

light;

end;

destructor tramka.done;

begin

if p<>nil then freemem(p,s);

p:=nil;

end;

procedure tramka.clear;

begin

mkactive;

unlight;

putimage(0,0,p^,normalput);

if p<>nil then freemem(p,s);

p:=nil;

end;

constructor tsubmenu.init;

var i:byte;

begin

n:=n1;

h:=15;

tramka.init(x1,y1,80,n*h+4);

for i:=1 to n do punkts[i]:=pnk[i];

col4:=14;

end;

procedure tsubmenu.draw;

var i:byte;

begin

tramka.draw;

setfillstyle(1,col4);

for i:=1 to n do begin

bar(3,(i-1)*h+3,width-3,(i)*h);

setcolor(col4);

rectangle(3,(i-1)*h+3,width-3,(i)*h) ;

setcolor(0);

outtextXY( 4, (i-1)*h+h div 2 , punkts[i])

end;

setcolor( red ); outtextXY( 4, h div 2 , punkts[1]);

rectangle(3,3,width-3,h);

end;

function tsubmenu.result;

var c:char; var i:byte;

begin

c:='q';

draw;

i:=1;

repeat

c:=readkey;

case c of

#72: begin

setcolor( 0 );

outtextXY( 4,(i-1)*h+h div 2,punkts[i] );

setcolor(col4);

rectangle(3,(i-1)*h+3,width-3,(i)*h) ;

if i=1 then i:=n

else i:=i-1;

setcolor ( red );

outtextXY( 4,(i-1)*h+h div 2,punkts[i] );

rectangle(3,(i-1)*h+3,width-3,(i)*h) ;

end;

#80: begin

setcolor( 0 );

outtextXY( 4,(i-1)*h+h div 2,punkts[i] );

setcolor(col4);

rectangle(3,(i-1)*h+3,width-3,(i)*h) ;

if i=n then i:=1

else i:=i+1;

setcolor ( red );

outtextXY( 4,(i-1)*h+h div 2,punkts[i] );

rectangle(3,(i-1)*h+3,width-3,(i)*h) ;

end;

end;

until (c=#13) or (c=#27) ;

if (c=#13) then result:=i

else result:=0;

while keypressed do readkey;

end;

constructor tmainmenu.init;

var i:byte;

begin

n:=n1;

heigth:=20;

width:=getmaxX-4;

h:=width div n;

tramka.init(2,2,width,heigth);

for i:=1 to n do punkts[i]:=pnk[i] ;

col4:=14;

end;

procedure tmainmenu.draw;

var i:byte;

begin

tramka.draw;

setfillstyle(1,col4);

setlinestyle(0,$aa,1);

for i:=1 to n do begin

bar((i-1)*h+3,3,i*h-1,heigth-3);

setcolor(col4);

rectangle((i-1)*h+3,3,i*h-1,heigth-3) ;

setcolor(black);

outtextXY( (i-1)*h+5, heigth div 2, punkts[i])

end;

setcolor( red ); outtextXY( 5, heigth div 2 , punkts[1]);

rectangle(3,3,h-1,heigth-3);

end;

function tmainmenu.result;

var c:char; var i:byte;

begin

c:='q';

draw;

i:=1;

repeat

c:=readkey;

case c of

#75: begin

setcolor( 0 );

outtextXY( (i-1)*h+5, heigth div 2 , punkts[i]);

setcolor(col4);

rectangle((i-1)*h+3,3,i*h-1,heigth-3) ;

if i=1 then i:=n

else i:=i-1;

setcolor ( red );

outtextXY( (i-1)*h+5, heigth div 2 , punkts[i]);

rectangle((i-1)*h+3,3,i*h-1,heigth-3) ;

end;

#77: begin

setcolor( 0 );

outtextXY( (i-1)*h+5, heigth div 2 , punkts[i]);

setcolor(col4);

rectangle((i-1)*h+3,3,i*h-1,heigth-3) ;

if i=n then i:=1

else i:=i+1;

setcolor ( red );

outtextXY( (i-1)*h+5, heigth div 2 , punkts[i] );

rectangle((i-1)*h+3,3,i*h-1,heigth-3) ;

end;

end;

until (c=#13);

if c=#13 then result:=i

else result:=n+1;

end;

procedure tmainmenu.getkoords;

begin

yI:=heigth+2;

xI:=x+(i-1)*h;

end;

begin

end.

unit int;

interface

uses ramki,graph,crt,tetobj;

procedure drawmenu(var res:longint);

procedure entername(score:longint;var name:string);

procedure best;

procedure clearbest;

implementation

procedure drawmenu;

var xI,yI:word;

i,j,k:byte;

C,d:CHAR;

block:tblock;

field:tfield;

x1,y1,x2,y2:integer;

smenu,op:tsubmenu;

mmenu:tmainmenu;

const men:menutype=('Game','Best Results','Options',

'','','','','','','');

smen1:menutype=('Start','Continue','Exit',

'','','','','','','');

smen3:menutype=('Size','Level',

'','','','','','','','');

smen2:menutype=('Results','Clear',

'','','','','','','','');

speed:menutype=('Level1','Level2','Level3',

'Level4','Level5','','','','','');

sz:menutype=('Small','Normal','Large',

'','','','','','','');

begin

mmenu.init(men,3);

i:=mmenu.result;

mmenu.unlight;

mmenu.getkoords(i,xI,yI);

case i of

1:begin

smenu.init(smen1,3,xI,yI);

j:=smenu.result;

smenu.clear;

if j=1 then res:=1;

if j=2 then res:=2;

if j=3 then res:=-3;

smenu.done;

end;

2:begin

smenu.init(smen2,2,xi,yi);

j:=smenu.result;

smenu.clear;

if j=1 then res:=-1;

if j=2 then res:=-2;

smenu.done;

end;

3:begin

smenu.init(smen3,2,xI,yI);

j:=smenu.result;

smenu.unlight;

if j=1 then begin

op.init(sz,3,smenu.x+smenu.width,smenu.y+3);

k:=op.result;

op.clear;

op.done;

if k=1 then res:=3;

if k=2 then res:=4;

if k=3 then res:=5;

end;

if j=2 then begin

op.init(speed,5,smenu.x+smenu.width,smenu.y+3);

k:=op.result;

op.clear;

op.done;

if (k>=1)and(k<=5)then res:=5+k;

end;

smenu.clear;

smenu.done;

end;

end;

end;

procedure entername;

type t=record

name:string;

score:longint;

end;

tf=file of t;

var a,b:tf;

c,d,t1:t;

ram:tramka;

i:byte;

bool:boolean;

begin

bool:=false;

assign(a,'file.txt');

reset(a);

assign(b,'temp.txt');

rewrite(b); t1.score:=score;

i:=0;

while (not eof(a))and(i<=12) do

begin

i:=i+1;

read(a,c);

write(b,c);

end;

close(a); close(b); rewrite(a); reset(b);

c.score:=1000000;

read(b,d);

write(a,c);

while not eof(b) do

begin

c:=d;

read(b,d);

if (d.score=score)

then begin

ram.init((GetMaxX-300)div 2,(GetMaxY-200)div 2,300,200);

ram.draw;

SetTextJustify(1,1);

OutTextXY(ram.width div 2, 30, 'Enter your nane:');

SetTextJustify(0,2);

setfillstyle(1,10);

bar((ram.width-150)div 2,115,(ram.width+150)div 2,135);

GotoXY(33,17);

textcolor(red);

textbackground(1);

readln(name);

t1.name:=name;

write(a,t1);

ram.clear;

ram.done;

bool:=true;

end;

write(a,d);

end;

close(a);

close(b);

if bool then best;

end;

procedure best;

type t=record

name:string;

score:longint;

end;

tf=file of t;

var a:tf;

i:byte;

x:t;

ram:tramka;

st:string;

begin

ram.init((GetmaxX-400)div 2,(GetMaxY-300)div 2,400,300);

ram.draw;

assign(a,'file.txt');

reset(a);

read(a,x);

for i:=1 to 10 do if not eof(a) then

begin

GoToXY(100,100);

read(a,x);

str(x.score,st);

outTextXY(20,50+i*15,x.name);OutTextXY(200,50+i*15,st);

end;

while keypressed do readkey;readkey;

ram.clear;

ram.done;

end;

procedure clearbest;

type t=record

name:string;

score:longint;

end;

tf=file of t;

var f:tf;

tt:t;

i:byte;

begin

assign(f,'file.txt');

rewrite(f);

tt.score:=100000;

write(f,tt);

for i:=1 to 50 do begin

tt.name:='noname';

tt.score:=5;

write(f,tt);

end;

close(f);

end;

begin

end.

unit game;

interface

uses graph,crt,windos,tetobj,ramki,int;

procedure startgame(var bl:tblock;var f:tfield;

var score:integer);

function time:real;

implementation

var ramka,r:tramka;

ng:boolean;

const cont:boolean=false;

ch:char=#27;

function time;

var h,m,s,ms : word;

begin

Gettime(h,m,s,ms);

time:=3600*h+60*m+s+ms/100;

end;

function fall(const bl:tblock; const f:tfield):boolean;

var t:boolean;

i,j:byte;

begin

t:=false;

for i:=1 to bl.mx do

for j:=bl.my downto 1 do

if ( bl.matr[i,j]<>0 )and

( f.matr[bl.x+i-1,bl.y+j]<>0 )

then t:=true;

fall:=t;

end;

function left(const bl:tblock; const f:tfield):boolean;

var t:boolean;

i,j:byte;

begin

t:=false;

for j:=1 to bl.my do

for i:=bl.mx downto 1 do

if ( bl.matr[i,j]<>0 )and

( f.matr[bl.x+i-2,bl.y+j-1]<>0 )

then t:=true;

left:=t;

end;

function right(const bl:tblock; const f:tfield):boolean;

var t:boolean;

i,j:byte;

begin

t:=false;

for j:=1 to bl.my do

for i:=bl.mx downto 1 do

if ( bl.matr[i,j]<>0 )and

( f.matr[bl.x+i,bl.y+j-1]<>0 )

then t:=true;

right:=t;

end;

procedure AddBlock( const b:tblock; var f:tfield);

var i,j:byte;

begin

for i:=1 to b.mx do

for j:=1 to b.my do

if b.matr[i,j]=1 then f.matr[b.x+i-1,b.y+j-1]:=1;

b.done;

end;

procedure NextFigure(var t1,p1:integer);

var bb:tblock;

begin

ramka.clear;

ramka.draw;

ramka.light;

OutTextXY(10,10,'Next:');

bb.init;

bb.x:=4-(bb.mx div 2);

bb.y:=5-(bb.my div 2);

bb.draw;

t1:=bb.t;

p1:=bb.pos;

bb.done;

end;

function CanBeRotated(const block:tblock;

const field:tfield):boolean;

var m,i,j:byte;

t:boolean;

begin

if block.mx>block.my then m:=block.mx else m:=block.my;

t:=true;

for i:=1 to m do

for j:=1 to m do

if field.matr[block.x+i-1,block.y+j-1]<>0 then

t:=false;

CanBeRotated:=t;

end;

procedure OutScore(score : integer);

var strsc:string;

begin

r.clear;

r.draw;

r.light;

str(score,strsc);

outtextxy(5,10,'Score:');

outtextxy(5,25, strsc);

end;

procedure changeoptions(k:byte;var speed:real);

begin

if k=1 then begin size:=15;

maxX:=15;

maxY:=24;

end;

if (k=2) then begin size:=12;

maxX:=20;

maxY:=30

end;

if k=3 then begin size:=12;

maxX:=25;

maxY:=35

end;

if k=4 then speed:=0.5;

if k=5 then speed:=0.45;

if k=6 then speed:=0.4;

if k=6 then speed:=0.37;

if k=7 then speed:=0.33;

if (k>=4)and(k<=8)then level:=k-3;

end;

procedure StartGame;

var i,j:byte;

tm,sc:real;

k1,k2:integer;

re:longint;

stt:string;

begin

re:=0;

score:=0;

sc:=score;

f.init(level);

f.draw;

ramka.init(350,50,6*size,7*size);

ramka.draw;

r.init(350,200,50,50);

r.draw;

nextfigure( k1,k2 );

Outscore(score);

setviewport( f.x1,f.y1,f.x1+size*maxX,f.y1+size*maxY, false);

while (not f.full)do begin

tm:=time;

bl.init2(k1,k2);

nextfigure( k1,k2 );

setviewport( f.x1,f.y1,f.x1+size*maxX,f.y1+size*maxY, false);

bl.draw;

{ch:='/'; }

while (not fall(bl,f))do begin delay(1000);

if keypressed then begin

ch:=readkey;

if ch=#0 then ch:=readkey;

bl.clear;

case ch of

#75: if not left(bl,f) then bl.x:=bl.x-1;

#77: if not right(bl,f) then bl.x:=bl.x+1;

#72: if canberotated(bl,f)then bl.rotate;

end; bl.draw; end;

if (time>=tm+speed)or (ch=#80) then begin

bl.clear;

bl.y:=bl.y+1;

tm:=time ;

bl.draw;

end;

if (ch=#27) then BEGIN

ramka.unlight;r.unlight;

REPEAT cont:=true;

drawmenu(re);

ch:='?';

if re=-1 then best ;

if re=-2 then begin clearbest;best;end;

if (re>=3)or(re=1)or(re=-3) then begin

if cont then begin

entername(score,stt);

bl.done;

f.clear;

ramka.clear;

r.clear;

ramka.done;

r.done;

changeoptions(re-2,speed);

end;

if re=-3 then halt;

exit;end;

UNTIL RE=2;

ch:='?';

ramka.light;r.light;

setviewport( f.x1,f.y1,f.x1+size*maxX,

f.y1+size*maxY, false);

END;

end;

addblock(bl,f);

bl.done;

for j:=1 to maxY do begin;

if f.fline(j) then begin

f.dline(j);

f.clear;

f.draw;

score:=score+10;

outscore( score );

setviewport( f.x1,f.y1,f.x1+size*maxX,f.y1+size*maxY ,true);

if score>=sc+50 then begin

sc:=score;

speed:=0.8*speed;

end;

end;

CH:=' '

end;

end;

cont:=false;

bl.done;

f.clear;

ramka.clear;

r.clear;

ramka.done;

r.done;

entername(score,stt);

drawmenu(re);

end;

begin

CONT:=FALSE;

end.

Висновки