uses crt,graph,dos;

  Const
  satir     = 10;
  sutun     = 15;
  yukseklik : Integer = 250;

   Type
    balonx      = Record
    x,y         : Integer;
    adimx,adimy : Integer;
    sayisi      : Integer;
   end;

   Type
    Kutux       = Record
    x,y         : Integer;
    adimx,adimy : Integer;
    hak         : Integer;
   end;

   Type
    Tmouse = Record
    x,y,button : Word;
   end;


    var
    gd , gm : Integer;
    Balon   : Balonx;
    Kutu    : Kutux;
    Dizi    : Array [0..satir,0..sutun] of Integer;
    Tus     : Char;
    size    : Integer;
    p       : Pointer;
    mouse   : Tmouse;


{*****************************************************}
{Mouse'u gizlemek icin}
Procedure Hidemouse;
begin
  asm
   mov ax,2;
   int $33;
  end;
end;
{Mouse'un hareket alanini belirtmek icin}
Procedure Setmousexy( x,y,x1,y1 : word );
begin
  asm
   mov ax,7;
   mov cx,x;
   mov dx,x1;
   int $33;
   mov ax,8;
   mov cx,y;
   mov dx,y1;
   int $33;
  end;
end;
{ Mouse imlecinin bulundugu pozisyonu ve basilan tusun degerini
bulan fonksiyon }
Function mouseposition( var mousex,mousey : word) : word;
  var
  mx,my,button : word;
begin
  asm
   mov ax,3;
   int $33;
   mov mx,cx;
   mov my,dx;
   mov button,bx;
  end;
   mousex := mx;
   mousey := my;
   mouseposition := button;
end;

{************************************************}
{Girilen sayisal degerleri string degerlere cevirir.}
  function yaziya_cevir(I: Longint): String;
   var
   s : string[11];
  begin
  Str(I, S);
  yaziya_cevir := S;
  end;

{************************************************}
{Bu procedure Alintidir ve "Halil ibrahim KALKAN'a" aittir fakat tarafimdan bu
procedure'de kucuk duzenlemeler yapilmistir}
Procedure bekle(sure : Byte);
  var
  saat,dakika,saniye,salise : word;
  tutulan,hesaplanan : Longint;
begin
gettime(saat,dakika,saniye,salise);
tutulan := salise;
repeat
  gettime(saat,dakika,saniye,salise);
  hesaplanan := salise;
until (abs (hesaplanan - tutulan) >= sure);
end;

{************************************************}
{Karsilama ekrani}
Procedure baslangic;
var
i :  Integer;
begin
Randomize;
  for i := getmaxx downto 100 do
   begin
   if i > getmaxx div 2 - 100 then
                              setcolor(1+random(4))
                              else setcolor(6+random(2));
   circle(getmaxx div 2,getmaxy div 2 ,i);
  end;
  setcolor(10);
  outtextxy(getmaxx div 2 - 25, getmaxy div  2 ,'BreakOut');

i := 0;
repeat
  if i < 255 then
             i := i + 1
             else i := 0;
             setrgbpalette(0,128,128,i);
until keypressed;
setrgbpalette(0,0,0,0);
  cleardevice;
end;

{************************************************}
{Bu procedure 'de oyun sirasinda gorsel olarak olusacak kutularin ekranda
olusmasi icin (satir * sutun) buyuklugundeki matrise degerler giriliyor}
Procedure Oyun_yap;
  var
  x , y : Integer;
begin
randomize;
  for y := 0 to satir do
  begin
   for x := 0 to sutun do
   begin
   dizi[y,x] := 1 + random(3);
   end;
  end;
end;
{************************************************}
{Bu procedure 'de ekranda hareket edecek olan kutunun x,y,adim miktari
gibi bilgiler olusturuluyor ve sekli ciziliyor}
Procedure Kutu_Yap;
begin
kutu.x     := getmaxx div 2;
kutu.y     := getmaxy - 30;
kutu.adimx := 4;
kutu.adimy := 0;
kutu.hak   := 4;

{Kutu'nun resmi ciziliyor}
setcolor(14);
rectangle(kutu.x,kutu.y,kutu.x+60,kutu.y+20);
setfillstyle(8,3);
floodfill(kutu.x+5,kutu.y+5,14);
{kutu'nun resminin buyuklugu size degiskeninde saklaniyor}
size := imagesize(kutu.x-1,kutu.y-1,kutu.x+60,kutu.y+20);
new(p);
getmem(p,size);
getimage(kutu.x-1,kutu.y-1,kutu.x+60,kutu.y+20,p^);
freemem(p,size);
end;
{************************************************}

{Bu procedure daha onceden olusturdugumuz ve bellekte sakladigimiz seklin
bellekten cagirilip ekranda goruntulenmesini ve hareket etmesi saglar}
Procedure kutu_hareket;
begin
   setmousexy(1,450,getmaxx - 60 ,478);
   hidemouse;
   mouse.button := mouseposition(mouse.x,mouse.y);

   getmem(P,Size);
   putimage(kutu.X-1,kutu.Y-1,P^,xorput);

  if mouse.button = 1 then begin dispose(p); exit; end;
  if (kutu.x<= getmaxx - 50)and((balon.sayisi>0)and(kutu.hak>0))
        then
        kutu.x := mouse.x;
  if (kutu.x >= 10)and((balon.sayisi>0)and(kutu.hak>0))
        then
        kutu.x := mouse.x;

   putimage(kutu.X-1,kutu.Y-1,P^,XORPUT);
   freemem(P,size);
end;

{************************************************}
{oyun_yap procedure'unda matrise girdigimiz degerlerin islenerek ekranda
bu degerleri temsil edecek kutulari gosteren procedure}
Procedure goster;
  var
  x , y : Integer;
begin
  for y := 0 to satir do
   for x := 0 to sutun do
   begin
    setfillstyle(6,dizi[y,x]);
    bar((x*((getmaxx-(getmaxx div sutun ))div sutun)),(y*((getmaxy-yukseklik)div satir)),
    (x*((getmaxx-(getmaxx div sutun))div sutun)+(getmaxx-(getmaxx div sutun))div sutun)
    ,(y*((getmaxy-yukseklik)div satir)+(getmaxy-yukseklik)div satir));
    end;
end;

{************************************************}
{Matrisin icindeki herhangi bir deger 0 'a esit oldugu zaman ekrandaki kutu
yu zemin rengine boyayan procedure}
Procedure sil(x,y : Integer);
begin
  balon.sayisi := balon.sayisi - 1;
    setfillstyle(1,0);
    bar((x*((getmaxx-(getmaxx div sutun ))div sutun)),(y*((getmaxy-yukseklik)div satir)),
    (x*((getmaxx-(getmaxx div sutun))div sutun)+(getmaxx-(getmaxx div sutun))div sutun)
    ,(y*((getmaxy-yukseklik)div satir)+(getmaxy-yukseklik)div satir));
   setbkcolor(14);
   bekle(1);
   setbkcolor(0);
end;
{************************************************}
{Sonuclar ekranda gosteriliyor}
Procedure Sonuclar;
begin
setfillstyle(10,2);
bar(1,getmaxy - 8,getmaxx,getmaxy);
setcolor(15);
outtextxy(5,getmaxy - 8,'Kutu Sayisi :'+yaziya_cevir(balon.sayisi));
outtextxy(160,getmaxy - 8,'Hak Sayiniz :'+yaziya_cevir(kutu.hak));
setcolor(10);
outtextxy(5,getmaxy - 20,'Written By : Deniz TURKAN');
end;

{************************************************}
{ Balon patlatilacak nesnelere carpti mi ? }
Procedure Balon_kontrol(x , y : Integer);
  var
  satir_bolen : Integer;
  sutun_bolen : Integer;
  sonuc       : Boolean;
  i,j         : Integer;
begin
satir_bolen := ((getmaxy-yukseklik+2) div satir);
sutun_bolen := ((getmaxx-(getmaxx div sutun ))div sutun);
x := x div sutun_bolen;
y := y div satir_bolen;

if (x>=0)and(x<=sutun)and(y>=0)and(y<=satir) then
if dizi[y,x] > 0 then
                  begin
                   if dizi[y,x] = 1 then
                   begin
                   dizi[y,x] := - dizi[y,x];
                    repeat
                    sonuc := True;
                     for i := 0 to satir do
                      for j := 0 to sutun do
                      if dizi[i,j] < 0 then
                      begin
                        if i > 0 then
                         if - dizi[i-1,j] = dizi[i,j] then
                                                      begin
                                                      dizi[i-1,j] := - dizi[i-1,j];
                                                      balon.sayisi := balon.sayisi - 1;
                                                      goster;
                                                      sonuc := False;
                                                      end;
                         if i < satir then
                          if - dizi[i+1,j] = dizi[i,j] then
                                                       begin
                                                       dizi[i+1,j] := - dizi[i+1,j];
                                                       balon.sayisi := balon.sayisi - 1;
                                                       goster;
                                                       sonuc := False;
                                                       end;
                         if j > 0 then
                          if - dizi[i,j-1] = dizi[i,j] then
                                                       begin
                                                       dizi[i,j-1] := - dizi[i,j-1];
                                                       balon.sayisi := balon.sayisi - 1;
                                                       goster;
                                                       sonuc:= False;
                                                       end;
                         if j < sutun then
                          if - dizi[i,j+1] = dizi[i,j] then
                                                       begin
                                                       dizi[i,j+1] := - dizi[i,j+1];
                                                       balon.sayisi := balon.sayisi - 1;
                                                       goster;
                                                       sonuc:= False;
                                                       end;

                      end;
                    until sonuc;

                       for i := 0 to satir do
                        for j := 0 to sutun do
                        if dizi[i,j]<0 then
                                       begin
                                       dizi[i,j] := 0;
                                       end;
                   end else
                  dizi[y,x] := dizi[y,x] - 1;
                  balon.adimy := -balon.adimy;
                  goster;



                    if dizi[y,x] = 0 then
                                         begin
                                         sil(x,y);
                                         sonuclar;
                                         end;
                  end else exit;
end;

{************************************************}
{Nesneleri  patlatacak olan balon olusturuluyor}
Procedure Balon_yap;
begin
balon.x      := getmaxx div 2;
balon.y      := getmaxy - 100;
balon.adimx  := 3;
balon.adimy  := 3;
balon.sayisi := (satir+1) * (sutun+1);
end;
{************************************************}
procedure balon_kutuya_carptimi(x,y : Integer; a,b : Integer);
begin
{Balon kutu'nun yuzeyine carpti mi ?}
  if  (x >= a + 5 ) and ( x <= a + 60 )
  and (y >= b - 5 ) and ( y <= b + 2  ) then
    begin
    balon.adimy := - balon.adimy;
    end else
  {Balon kutu'nun sol kosesine carpti mi ?}
  if  (x >= a ) and ( x <= a + 4 )
  and (y >= b - 5 ) and ( y <= b + 18  ) then
    begin
    balon.adimy := - balon.adimy;
    balon.adimx := - balon.adimx;
    end else
  {Balon kutu'nun sag kosesine carpti mi ?}
  if  (x >= a + 60 ) and ( x <= a + 64 )
  and (y >= b - 5 ) and  ( y <= b + 18  ) then
    begin
    balon.adimy := - balon.adimy;
    balon.adimx := - balon.adimx;
    end;
end;
{************************************************}
{Eger balon yere carpti ise ve patlayan engel varsa patlayan engeller
yeniden olusturuluyor}
Function Doldur : Boolean;
  var
   i,j,n : byte;
begin
n := 0;
for i := 0 to satir do
  for j := 0 to sutun do
   if dizi[i,j] = 0 then
                    begin
                    doldur := True;
                     if n <= 2 then
                              n := n + 1 else
                                         begin
                                         n := 0; exit;
                                         end;

                    dizi[i,j] := 1+random(2);
                    balon.sayisi := balon.sayisi + 1;
                    goster;
                    sonuclar;
                    end else doldur := False;
   end;

{************************************************}
procedure balon_hareket;
begin
   balon_kontrol(balon.x,balon.y);
   balon_kutuya_carptimi(balon.x,balon.y,kutu.x,kutu.y);
   setLineStyle(0,0,ThickWidth);
   setwritemode(xorput);

   if (balon.x <= 10)or(balon.x >= 630) then
                                   balon.adimx := -balon.adimx;
   if (balon.y <= 10) then
                    balon.adimy := -balon.adimy;
   if (balon.y >= getmaxy) then
                         begin
                         if  not doldur then
                                       begin
                                       kutu.hak := kutu.hak - 1;
                                       sonuclar;
                                       end;
                         balon.adimy := -balon.adimy;
                         setbkcolor(4);
                         bekle(1);
                         setbkcolor(0);
                         balon.y := kutu.y - 50;
                         end;

   if (balon.sayisi > 0)and(kutu.hak > 0)
                                then
                                balon.x := balon.x + balon.adimx;
   if (balon.sayisi > 0)and(kutu.hak > 0)
                                then
                                balon.y := balon.y + balon.adimy;
    setcolor(15);
    circle(balon.x,balon.y,2);
    {bekle(1);}
    setcolor(15);
    circle(balon.x,balon.y,2);
end;
{************************************************}


begin
  gd := Detect;
  Initgraph(gd,gm,'d:\tp7\bgi');
   oyun_yap;
   baslangic;
       balon_yap;
         Kutu_yap;
            goster;
             sonuclar;
    Repeat
    if keypressed then tus := readkey;
     balon_hareket;
     kutu_hareket;
    Until tus = #27;
    closegraph;
     gotoxy(1,1);
     write('Written By : Deniz TURKAN');
     gotoxy(1,2);
     write('deniz_turkan@yahoo.com');
     gotoxy(10,3);
     write('- 2004 -');
end.