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 a0 then aci:=arctan((b2-b)/(a2-a)) else yer:=ii; if aciextreme[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 aciextreme[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 aciextreme[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 aci0 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.