uses crt,dos;
type
   coor = record
     i :word;
     j :word;
    end;
   coord = Array[1..100] of coor;
     mat = Array[1..100,1..100] of byte;
      ex = Array[1..4] of coor;
     cev = Array[1..100] of coor;
     ciz = Array[1..29] of string[30];

var matris:mat; extreme:ex;
    n,m,L:word; cevre:cev; ch:char;
    cizgiler : ciz;

Procedure Set_ciz(var cizgiler : ciz);
begin
  cizgiler[1]:= 'ΪΔΒΔΒΔΒΔΒΔΒΔΒΔΒΔΒΔΒΔΒΔΒΔΒΔΒΔΏ';
  cizgiler[2]:= '³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[3]:= 'ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[4]:= '³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[5]:= 'ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[6]:= '³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[7]:= 'ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[8]:= '³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[9]:= 'ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[10]:='³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[11]:='ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[12]:='³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[13]:='ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[14]:='³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[15]:='ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[16]:='³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[17]:='ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[18]:='³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[19]:='ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[20]:='³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[21]:='ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[22]:='³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[23]:='ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[24]:='³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[25]:='ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[26]:='³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[27]:='ΓΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔ΄';
  cizgiler[28]:='³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³';
  cizgiler[29]:='ΐΔΑΔΑΔΑΔΑΔΑΔΑΔΑΔΑΔΑΔΑΔΑΔΑΔΑΔΩ ';
end;

Procedure OKU(var n:word; var m:word; var matris:mat);
var dosya:Text; ii, jj, kk:word;
Begin
{i-}
 assign(dosya,'cerceve.dat');
 reset(dosya);
 if ioresult<>0 then
                 begin
                  write('cerceve.dat couldn't opened...');
                  halt;
                 end;
{i+}
 clrscr;
 ii:=0; jj:=0;
 while not EOF(dosya) do
  begin
   inc(ii);
   while not EOLN(dosya) do
    begin
     read(dosya,ch);
     if ch=' ' then
        begin
         inc(jj);
         matris[ii,jj]:=0;
        end;
     if ch='1' then
        begin
         inc(jj);
         matris[ii,jj]:=1;
        end;
    end;
   readln(dosya); m:=jj; n:=ii;
   jj:=0;
  end;
 close(dosya);
end;

Procedure Extreme_Noktalar(var extreme:ex);
var test1,test2:array[1..100] of coor;
    ii,jj,k,t,t2:integer;
Begin
 k:=0; t:=0;
 {search colons}
 for ii:=1 to 100 do
  begin
   test1[ii].i:=0;
   test2[ii].i:=0;
   test1[ii].j:=0;
   test2[ii].j:=0;
  end;
 for jj:=1 to m do
  begin
   for ii:=1 to n do
    if matris[ii,jj]=1 then
       begin
        t:=t+1;
        test1[t].i:=ii;
        test1[t].j:=jj;
       end;
   if ((test1[1].i>0)and(test2[1].i=0)) then
      begin
       inc(k);
       extreme[k].i:=test1[t].i;
       extreme[k].j:=test1[t].j;
      end
     else if ((test1[1].i=0)and(test2[1].i<>0)) then
            begin
             inc(k);
             extreme[k].i:=test2[t2].i;
             extreme[k].j:=test2[t2].j;
            end;
   if test1[1].i<>0 then
     for ii:=1 to t do
       begin
        test2[ii].i:=test1[ii].i;
        test2[ii].j:=test1[ii].j;
       end;
   for ii:=1 to t do
     begin
       test1[ii].i:=0;
       test1[ii].j:=0;
     end;
   t2:=t;
   t:=0;
  end;
 {search lines}
 for ii:=1 to 100 do
  begin
   test1[ii].i:=0;
   test2[ii].i:=0;
   test1[ii].j:=0;
   test2[ii].j:=0;
  end;
 for ii:=1 to n do
  begin
   for jj:=1 to m do if matris[ii,jj]=1 then
    begin
     inc(t);
     test1[t].i:=ii;
     test1[t].j:=jj;
    end;
   t2:=t;
   if ((test1[1].i<>0)and(test2[1].i=0)) then
      begin
       inc(k);
       extreme[k].i:=test1[t2].i;
       extreme[k].j:=test1[t2].j;
      end
     else if ((test1[1].i=0)and(test2[1].i<>0)) then
            begin
             inc(k);
             extreme[k].i:=test2[1].i;
             extreme[k].j:=test2[1].j;
            end;
   if test1[1].i<>0 then
     for jj:=1 to t do
      begin
       test2[jj].i:=test1[jj].i;
       test2[jj].j:=test1[jj].j;
      end;
   for jj:=1 to t do
     begin
       test1[jj].i:=0;
       test1[jj].j:=0;
     end;
   t:=0;
  end;
End;

Procedure Cevre_Bul(matris:mat;var extreme:ex; var cevre:cev;var L:word);
var  a, b, a2, b2, ii, jj, k, yer:integer; ac, aci:real;
     test:Array[1..100] of coor;
Begin
 L:=1; {Contour Ponts Between Down And Left Extremes START}
 cevre[L].i:=extreme[1].i;
 cevre[L].j:=extreme[1].j;
 a:=extreme[1].i;
 b:=extreme[1].j;
 while a<extreme[4].i do
  begin
   k:=0;
   for ii:=a+1 to extreme[4].i do
    for jj:=b to extreme[4].j do
     if matris[ii,jj]=1 then
       begin
        inc(k);
        test[k].i:=ii;
        test[k].j:=jj;
       end;
   ac:=360;
   for ii:=1 to k do
    begin
     a2 :=test[ii].i;
     b2 :=test[ii].j;
     if (a2-a)<>0 then aci:=arctan((b2-b)/(a2-a))
      else yer:=ii;
     if aci<ac then
       begin
        yer:=ii;
        ac:=aci;
       end;
    end;
   inc(L);
   cevre[L].i:=test[yer].i;
   cevre[L].j:=test[yer].j;
   a:=test[yer].i;
   b:=test[yer].j;
  end;  {Contour Ponts Between Down And Left Extremes  END}

{ Contour Ponts Between Down And Right Extremes START }
 a:=extreme[4].i;
 b:=extreme[4].j;
 while a>extreme[2].i do
  begin
   k:=0;
   for ii:=a-1 downto extreme[2].i do
    for jj:=b to extreme[2].j do
     if matris[ii,jj]=1 then
       begin
        inc(k);
        test[k].i:=ii;
        test[k].j:=jj;
       end;
   ac:=360;
   for ii:=1 to k do
    begin
     a2 :=test[ii].i;
     b2 :=test[ii].j;
     if (b-b2)<>0 then aci:=arctan((a2-a)/(b-b2))
      else yer:=ii;
     if aci<ac then
       begin
        yer:=ii;
        ac:=aci;
       end;
    end;
   inc(L);
   cevre[L].i:=test[yer].i;
   cevre[L].j:=test[yer].j;
   a:=test[yer].i;
   b:=test[yer].j;
  end;
{ Contour Ponts Between Right And Up Extremes }
 a:=extreme[2].i;
 b:=extreme[2].j;
 while a>extreme[3].i do
  begin
   k:=0;
   for ii:=a-1 downto extreme[3].i do
    for jj:=b downto extreme[3].j  do
     if matris[ii,jj]=1 then
      begin
       inc(k);
       test[k].i:=ii;
       test[k].j:=jj;
      end;
   ac:=360;
   for ii:=1 to k do
    begin
     a2:=test[ii].i;
     b2:=test[ii].j;
     if (a-a2)<>0 then aci:=arctan(abs((b-b2)/(a-a2)))
      else yer:=ii;
     if aci<ac then
      begin
       yer:=ii;
       ac:=aci;
      end;
     if (a-a2)=0 then yer:=ii;
    end;
   inc(L);
   cevre[L].i:=test[yer].i;
   cevre[L].j:=test[yer].j;
   a:=test[yer].i;
   b:=test[yer].j;
  end;
 {Contour Ponts Between Up And Left Extremes }
 a:=extreme[3].i;
 b:=extreme[3].j;
 while b>extreme[1].j do
  begin
   k:=0;
   for jj:=b-1 downto extreme[1].j do
    for ii:=a to extreme[1].i do
     if matris[ii,jj]=1 then
      begin
       inc(k);
       test[k].i:=ii;
       test[k].j:=jj;
      end;
   ac:=360;
   for ii:=1 to k do
    begin
     a2:=test[ii].i;
     b2:=test[ii].j;
     if (b-b2)<>0 then aci:=arctan((a2-a)/(b-b2))
      else yer:=ii;
     if aci<ac then
      begin
       yer:=ii;
       ac:=aci;
      end;
    end;
   inc(L);
   cevre[L].i:=test[yer].i;
   cevre[L].j:=test[yer].j;
   a:=test[yer].i;
   b:=test[yer].j;
  end;
End;

Procedure Yaz_Matris_Okunan(n,m : word; matris : mat; cizgiler : ciz);
var ii,jj,k1,k2:byte;
Begin
  writeln('--------Input Points--------');
  window(1,2,37,31);
  for ii:=1 to 29 do writeln(cizgiler[ii]);
  for ii:=1 to n do
   begin
    for jj:=1 to n do
     begin
      gotoxy(jj*2,ii*2);
      if Matris[ii,jj]<>0 then write(Matris[ii,jj]);
      end;
   end;
  window(1,1,80,50);
End;

Procedure Yaz_Extreme(extreme:ex);
var ii:byte;
Begin
  gotoxy(1,33);
  for ii:=1 to 4 do
   begin
    writeln(ii,'. Extreme=(',extreme[ii].i,',',extreme[ii].j,')');
   end;
End;

Procedure Yaz_Cevre_Noktalari(cevre:cev;L:word);
var ii,jj:byte;
Begin
  gotoxy(39,1);
  writeln('Contour Points...');
  window(38,2,80,50);
  for ii:=1 to 29 do writeln(cizgiler[ii]);
  for ii:=1 to L do
   begin
    gotoxy(cevre[ii].j*2,cevre[ii].i*2); write('1');
   end;
  window(1,1,80,50);
End;

BEGIN
 clrscr;
 TextMode(Lo(LastMode)+Font8x8);
 OKU(n,m,matris);
 Set_ciz(cizgiler);
 Yaz_Matris_Okunan(n,m,matris,cizgiler);
 Extreme_Noktalar(extreme);
 Yaz_Extreme(extreme);
 Cevre_Bul(matris,extreme,cevre,L);
 Yaz_Cevre_Noktalari(cevre,L);
 repeat ch:=readkey until ch=#27;
 clrscr;
END.
