program Bejeweled;
uses crt;
const xSt=4; ySt=2;
var m:array[1..8,0..8] of shortint;
x,y,z:byte; preMark,mark:word; x1s,y1s,x2s,y2s,xP,yP:byte;
timebegin,timepause:longint; level:byte;

procedure writexy(x,y:byte;c:string);
begin gotoxy(x,y); write(c); end;

Procedure Delay(ms:word);
var t: longint; n:real;
begin n:=ms/1000;
t := meml[0:$46C];
repeat until meml[0:$46C] - t > n*18.2;
end;

procedure vekhung(x1,y1,x2,y2:word);
var z,a,b:word;
begin
if (x1<>x2) and (y1<>y2) then
begin
a:=wherex; b:=wherey;
 if x1>x2 then
  begin z:=x1; x1:=x2; x2:=z; end;
 if y1>y2 then
  begin z:=y1; y1:=y2; y2:=z; end;
 gotoxy(x1,y1); write(#201);
 if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205);
 gotoxy(x2,y1); write(#187);
 gotoxy(x1,y2); write(#200);
 if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205);
 gotoxy(x2,y2); write(#188);
 if y2-y1>1 then for z:=1 to y2-y1-1 do begin
 gotoxy(x1,z+y1); write(#186); end;
 if y2-y1>1 then for z:=1 to y2-y1-1 do begin
 gotoxy(x2,z+y1); write(#186); end;
end;
gotoxy(a,b);
end;

function getmousex:word; assembler; asm
mov ax,3; int 33h; mov ax,cx end;

function getmousey:word; assembler; asm
mov ax,3; int 33h; mov ax,dx end;

function leftpressed:boolean; assembler; asm
mov ax,3; int 33h; and bx,1; mov ax,bx end;

function rightpressed:boolean; assembler; asm
mov ax,3; int 33h; and bx,2; mov ax,bx end;

function mouserange(x1,y1,x2,y2:word):boolean;
begin
if        (getmousex div 8>=x1)
      and (getmousex div 8<=x2)
      and (getmousey div 8>=y1)
      and (getmousey div 8<=y2)
then mouserange:=true
else mouserange:=false;
end;

function getmousexcrt:word;
begin
getmousexcrt:=trunc(getmousex/8+1);
end;

function getmouseycrt:word;
begin
getmouseycrt:=trunc(getmousey/8+1);
end;

procedure down;
var z:byte;
begin
for x:=8 downto 1 do
 for y:=8 downto 1 do
 while m[x,y]<0 do
  begin
  m[x,0]:=random(7)+9;
  for z:=y downto 1 do
  m[x,z]:=m[x,z-1];
  end;
end;
function Del:byte;
var count:byte;
begin
count:=0;
{row}
for x:=1 to 6 do
 for y:=1 to 8 do
 begin
  if (abs(m[x,y])=abs(m[x+1,y]))
  and (abs(m[x,y])=abs(m[x+2,y]))
  then begin
      m[x,y]:=-abs(m[x,y]);
      m[x+1,y]:=-abs(m[x+1,y]);
      m[x+2,y]:=-abs(m[x+2,y]);
      inc(count);
      end;
 end;
{Columns}
for x:=1 to 8 do
 for y:=1 to 6 do
 begin
  if (abs(m[x,y])=abs(m[x,y+1]))
  and (abs(m[x,y])=abs(m[x,y+2]))
  then begin
      m[x,y]:=-abs(m[x,y]);
      m[x,y+1]:=-abs(m[x,y+1]);
      m[x,y+2]:=-abs(m[x,y+2]);
      inc(count);
      end;
 end;
del:=count;
end;
procedure rand;
begin
for x:=1 to 8 do
 for y:=1 to 8 do
 m[x,y]:=random(7)+9;
 repeat down; until del=0;
end;
procedure init;
begin
randomize;
textmode(co80); textcolor(white); clrscr; x:=30;
writexy(x,11,#75#32#32#75#32#73#32#69#69#69#69#32#78#32#32#78);
writexy(x,12,#75#32#75#32#32#73#32#69#32#32#32#32#78#78#32#78);
writexy(x,13,#75#75#32#32#32#73#32#69#69#69#32#32#78#32#78#78);
writexy(x,14,#75#32#75#32#32#73#32#69#32#32#32#32#78#32#32#78);
writexy(x,15,#75#32#75#32#32#73#32#69#69#69#69#32#78#32#32#78);
writexy(x,16,#45#45#45#45#45#45#45#45#45#45#45#45#45#45#45#45);
writexy(x,17,#67#32#79#32#73#32#95#32#49#32#57#32#57#32#55#32);
writexy(x,5,#66#32#69#32#74#32#69#32#87#32#69#32#76#32#69#32#68);
writexy(25,9,#66#97#110#32#113#117#121#101#110#58);
writexy(37,9,#107#105#101#110#95#99#111#105#95#49#57#57#55);
textcolor(lightgray);
writexy(x,22,#76#32#79#32#65#32#68#32#73#32#78#32#71);
textcolor(yellow); gotoxy(x,22);
write(#76#32);delay(100);
write(#79#32);delay(100);
write(#65#32);delay(100);
write(#68#32);delay(100);
write(#73#32);delay(100);
write(#78#32);delay(100);
write(#71);delay(100);
textcolor(white);
writexy(x,22,' S  T  A  R  T');
vekhung(x-5,20,x+18,24);
while not mouseRange(x-5,20,x+19,24)
      or not leftpressed
      do m[1,1]:=random(100);
rand;
end;
function x0S:byte; begin x0s:=(GetMouseXcrt-xSt+3)div 4; end;
function y0S:byte; begin y0s:=(GetMouseycrt-ySt+3)div 3; end;

procedure draw;
begin
for x:=1 to 8 do
 for y:=1 to 8 do
 begin
  if m[x,y]<0 then begin textcolor(black); textbackground(black); end
  else
  begin
  if (x=x1S) and (y=y1S) or (x=x2S) and (y=y2S) or (x=xP) and (y=yP)
  then begin textbackground(m[x,y]-8); textcolor(m[x,y]); end
  else begin textcolor(m[x,y]-8); textbackground(black); end;
  writexy(x*4-3+xSt,y*3-3+ySt,#220#220#220);
  writexy(x*4-3+xSt,y*3-2+ySt,#219#219#219);
  writexy(x*4-3+xSt,y*3-1+ySt,#223#223#223);
  end;
 end;
end;
procedure time;
begin
x:=15+mark*2; dec(x,trunc((meml[0:$46C] - timebegin)/18.2));
if x>30 then x:=30;
case x of
01..10: begin textcolor(lightred); textbackground(red); end;
11..20: begin textcolor(yellow); textbackground(brown); end;
21..30: begin textcolor(lightgreen); textbackground(green); end;
end;
for z:=1 to x do
writexy(41+z,4,#219);
write(' ':30-x+1);
gotoxy(45,8); write(mark*100+premark*100);
textbackground(black); write('':10);
end;
procedure GetSelected;
begin
if leftpressed then
begin
 if abs(xP-x1S)+abs(yP-y1S)=1 then
    begin x2S:=xP; y2S:=yP; end
 else begin x1S:=xP; y1S:=yP; x2S:=0; y2s:=0; end;
end else begin x1S:=0; x2S:=0; y1S:=0;y2S:=0; end;
end;
procedure swap(x1,y1,x2,y2:byte);
var z:shortint;
begin
z:=m[x1,y1];
m[x1,y1]:=m[x2,y2];
m[x2,y2]:=z;
end;
procedure pause;
begin
      textcolor(white); textbackground(black);
      writexy(43,12,'CONTINUE ');
      repeat until not leftpressed; timepause:=meml[0:$46C];
      repeat until leftpressed and mouserange(40,10,55,12);
      writexy(43,12,'P A U S E');
      timepause:=meml[0:$46C]-timepause;
      timebegin:=timebegin+timepause;
end;
procedure last(status:string);
begin
textbackground(black); textcolor(lightred);
for x:=1 to 8*3 do writexy(xst,yst+x-1,'                                ');
writexy(10,10,status);
gotoxy(10,12); write('Your score :  ',mark+premark:5,'00');
vekhung(8,14,32,16); writexy(12,15,'P l a y  A g a i n');
writexy(17,18,'or');
vekhung(8,20,32,22); writexy(12,21,'  E  X  I  T  ');
repeat
 if mouserange(8,19,32,21) and leftpressed then halt;
 if mouserange(8,13,32,15) and leftpressed then level:=0;
until level=0; mark:=0;
for x:=1 to 8 do
 for y:=1 to 8 do
 begin
  writexy(x*4-3+xSt,y*3-3+ySt,#32#32#32#32);
  writexy(x*4-3+xSt,y*3-2+ySt,#32#32#32#32);
  writexy(x*4-3+xSt,y*3-1+ySt,#32#32#32#32);
 end;
end;
procedure next;
begin
textbackground(black);
for x:=1 to 8*3 do writexy(xst,yst+x-1,'                                ');
writexy(5,8,'C O N G R A T U L A T I O N S ! ');
writexy(5,10,'You can come to next level now!');
gotoxy(5,12); write('Your score  :  ',mark+premark:5,'00');
vekhung(8,14,32,16); writexy(12,15,'N E X T  L E V E L');
writexy(17,18,'or');
vekhung(8,20,32,22); writexy(12,21,'  E  X  I  T  ');
repeat
 if mouserange(8,19,32,21) and leftpressed then halt;
until mouserange(8,13,32,15) and leftpressed;
preMark:=mark+premark; mark:=0;
rand; level:=0;
end;
BEGIN
init; level:=0;
repeat
inc(level);
textcolor(white); textbackground(black);
clrscr; for z:=2 to 25 do
begin writexy(xSt+33,z,#186); writexy(xSt-1,z,#186); end;
writexy(xSt+5,1,#66#32#69#32#74#32#69#32#87#32#69#32#76#32#69#32#68);
vekhung(40,3,75,5); writexy(43,3,'  Time Trial  ');
vekhung(40,7,75,9); writexy(43,7,'  Score  ');
vekhung(40,11,55,13); writexy(43,12,'P A U S E');
vekhung(60,11,75,13); writexy(63,12,'E  X  I  T');
vekhung(40,15,55,17); writexy(43,16,' M  I  X ');
vekhung(60,15,75,17); writexy(63,16,'RE - PLAY');
timebegin := meml[0:$46C];
repeat
if leftpressed then
begin
    if mouserange(40,10,55,12) then pause
else if mouserange(60,10,75,12) then halt
else if mouserange(40,14,55,16) then rand
else if mouserange(60,14,75,16) then
begin last('You played again!'); level:=1;
timebegin := meml[0:$46C]; end
else getselected;
end;
xP:=x0S; yP:=y0s;
repeat until not leftpressed;
if x2s>0 then
begin
  swap(x1S,y1S,x2S,y2S); delay(100);
  z:=del; draw; delay(100);if z=0 then swap(x1S,y1S,x2S,y2S)
  else begin mark:=mark+z; down;
      repeat z:=del; draw; delay(100); mark:=mark+z; down; until z=0;
      end;
x1s:=0; x2s:=0; y1s:=0; y2s:=0;
end;
draw;
repeat time; until leftpressed or (xP<>x0S) or (yP<>y0s)
            or (meml[0:$46C] - timebegin > (15+mark*2)*18.2)
            or ((15+mark*2)-(trunc((meml[0:$46C] - timebegin)/18.2))>29);
until (meml[0:$46C] - timebegin > (15+mark*2)*18.2)
  or ((15+mark*2)-(trunc((meml[0:$46C] - timebegin)/18.2))>29);
if ((15+mark*2)-(trunc((meml[0:$46C] - timebegin)/18.2))>29)
then next else last('You are lost!');
until level>0;
END.