Miscellany

//Robertas Jurkaitis, 8 grupe, 1 uzduotis, 7 variantas
//Nuskaito src.txt, surikiuoja pagal galunes, isveda i rez.txt
program uzd1;
const abc='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
      inp='src.txt';
      outp='rez.txt';
type mas = array [1..1000] of string;


function readz(failas:string; var arr:mas):integer;
var r:char;
    nr, wordnum:integer;
    word:string;
    
begin
    {$I-}
    assign(f, inp);
    reset(f);
    if IOResult = 0 then
    begin
	{$I+}
        word:=''; wordnum:=0;
        while not Eof(f) do
        begin
            read(f, r);
            nr:=pos(r, abc);
            if nr>0 then
            begin
                word:=word+r;
            end
            else
            begin
                if pos(r, abc)=0 then
                if word<>'' then
                begin
                    wordnum:=wordnum+1;
                    arr[wordnum]:=word;
                end;
                word:='';
            end;
        end;
        if word<>'' then
        begin
            wordnum:=wordnum+1;
            arr[wordnum]:=word;
            word:='';
        end;
        close(f);
        readz:=wordnum;
    end
    else
	begin
	    readz:=-1;
	    {$I+}
	end;
end;

procedure rik(var arr:mas; wordnum:integer);
var i, j, k, m, n:integer;
    temp:string;
    l:boolean;
begin
    for i:=1 to wordnum do
    begin
        for j:=i to wordnum do
        begin
            l:=true;
            k:=0;
            while l do
            begin
                k:=k+1;
                m:=ord(arr[i][length(arr[i])-k+1]);
                n:=ord(arr[j][length(arr[j])-k+1]);
                if m>=97 then m:=m-32;
                if n>=97 then n:=n-32;
                if m>n then
                begin
                    temp:=arr[j];
                    arr[j]:=arr[i];
                    arr[i]:=temp;
                    l:=false;
                end
                else if m<n then
                begin
                    l:=false
                end;
                if ((k=length(arr[i]))or(k=length(arr[j]))) and l then
                begin
                    if length(arr[i])>length(arr[j]) then
                    begin
                        temp:=arr[j];
                        arr[j]:=arr[i];
                        arr[i]:=temp;
                    end;
                    l:=false;
                end;
            end;
        end;
    end;
end;

procedure print(failas:string; var arr:mas; wordnum:integer);
var i:integer;
    f:text;
begin
    assign(f, failas);
    rewrite(f);
    for i:=1 to wordnum do writeln(f, arr[i]);
    writeln('Failas src.txt nuskaitytas ir jame esantis tekstas surikiuotas pagal galunes faile ', failas, '.');
    close(f);
end;

var f:text;
    arr:mas;
    wordnum:integer;

begin
    wordnum:=readz(inp, arr);
	if wordnum=-1 then
	begin
	     writeln('Nera failo');
	     halt;
        end;
    rik(arr, wordnum);
    print(outp, arr, wordnum);
end.