yosr

program pp;
uses wincrt;
Type
mat=Array[1..100,1..100] of byte;

var
f:text;
m:mat;
mo:string;
n,l:Byte;


Function alpha (ch:string):Boolean;
var
i:byte;
begin
i:=0;
Repeat
i:=i+1;
until(not(Upcase (ch[i]) in ['A'..'Z'])) or (i=Length(ch));
alpha:=Upcase(ch[i]) in ['A'..'Z'];
end;

procedure remp (var mo:string;n:byte) ;
Var i:byte;
Begin
repeat
writeln ('donner le nombre de mots a chercher:');
Read(n);
until n in [1..10];
for i:=1 to n do
repeat
write ('donner le mot n',i,':');
readln (mo[i]);
until (Length(mo[i]>0) and (alpha(mo[i])=true)
end;

procedure former( var m:mat;mo:string;n:byte;l:byte; f:text) ;
 Var
 c,b:byte;
 ch,l:string;
 d:text;
begin
reset(f);
l:=0;
while not Eof(f) do
readln(f,ch);
Assign (d,ch);
l:=l+1;
for c:=1 to n do
reset (d);
b:=0;
while not eof(d) Do
readln (d,b);
if pos (mo[c],b)>0 then b:=b+1
m[l,c]:=b;
close(d);
close(f);
end;



Procedure affich (m:mat;mo:string;n,l:byte;var f:text);
var
i,j:integer;
ch:string;
Begin
for j:=1 to n Do
write (mo[j],':');
reset(f);
for i:=1 to l Do
readln (f,ch);
if m[i,j]>0 then
write (ch,'');
end;



Begin
Assign (f,'chemin.txt');
remp (mo,n);
former (m,mo,n,l,f);
affich(m,mo,n,l,f);
end.