unit fonet;

interface

const souhl:set of char=[')','B','G','D','H','W','Z','X','+','Y','K','L',
            'M','N','S','(','P','C','Q','R','&','$','T'];
      samohl:set of char=['A','F','E','"','I','O','U'];

   { upcas: budou se nektere pismena zobrazovat jako velka?
           (kvuli cteni skrze hlasovy vystup kuk)
     upc_a: podvolba pro ajin a alef }
      config_upcas:boolean =true;
      config_upc_a:boolean =true;
   {vypisovat pri hledani zacatku kapitol tecky ?}
      config_seek_w:boolean= true;

type w=record
            book:array[1..2] of char;
            num:array[1..4] of byte;
            wor,lem,morf:string;
            kere,note,langu,st:char;
           end;
     analys1=record
            sou,sam:char;
            dag,she,acc:boolean;
            delk:byte;
           end;
     analys2=record
           sou1,sam,sou2:char;
           dag1,dag2,she,acc,uzav,furt,upc,upc_n:boolean;
           delk:byte;
             end;
    Fchr=file of char;
      Tloader=object
        buffer:string;
        bf:array [1..1024] of char;
        bfpos,bfres:word;
        ef:boolean;
        chap_pos:longint;
        nm: array [1..3] of byte;
      procedure init;
      function readbf(var f:file):char;
      function eof:boolean;
      function readstr(var f:file):string;
      function loadlin(var f:file):string;
      procedure findchap(ch:byte;var f:file);
      procedure seekchap(var f:file);
          end;


var bks:array [1..39] of record
	   b:array[1..2] of char;
	   e:array[1..4] of char;
	   n:string;
			 end;
    dr:string;

{*}procedure bksinit;
{*}procedure divi(s:string; var d:w);
function transf(s:string):string;
function deco(var ww:w):string;
function upcas(ch:char):char;
function trans_hs(s:string):string;
function trans_cz(s:string):string;
{*}function trans_sh(s:string):string;
{*}function trans_sm(s:string):string;
function syl (s:string; i:byte): byte;
procedure anl1 (s:string;f, t:byte; var an:analys1);
function podklad(s:string;i:byte;var an:analys1):byte;
function anl(s:string; f:byte;var  an:analys2):byte;
{*}procedure clean_anl(an:analys2);
function rekni_s(ch:char;dages,furt:boolean;var upc:boolean):string;
function rekni_sm(ch:char;delk:byte):string;
function rekni(an,an_l:analys2):string;
{*}function fonetic(s:string):string;

implementation

procedure bksinit;
var f:text;
    s:string;
    i:byte;
begin
assign(f,dr+'morf94.dir');
reset(f);
for i:=1 to 39 do
with bks[i] do
 begin
 readln(f,s);
 b[1]:=s[1];
 b[2]:=s[2];
 e[1]:=s[4];
 e[2]:=s[5];
 e[3]:=s[6];
 e[4]:=s[7];
 n:=copy(s,9,length(s)-8);
end;
close(f);
end;
{==============================================================}
{==============================================================}
{==============================================================}

procedure divi(s:string; var d:w);
var i,j,ll:byte;
    cd:integer;

begin
with d do begin
kere:=' ';
note:=' ';
book[1]:=upcase(s[1]);
book[2]:=upcase(s[2]);
i:=3;
j:=pos(':',s);
val(copy(s,i,j-i),num[1],cd);

i:=j+1;
j:=pos(',',s);
val(copy(s,i,j-i),num[2],cd);

i:=j+1;
j:=pos('.',s);
val(copy(s,i,j-i),num[3],cd);


i:=j+1;j:=i+1;
val(copy(s,i,j-i),num[4],cd);

{============== note ======================}

if s[j]=']' then begin
 note:=s[j+1];
 j:=j+2;
  end;


i:=j+1;
j:=pos(' ',copy(s,i,length(s)-i+1))+i-1;
wor:=copy(s,i,j-i);

{==================== Kere - Qetib =======}

if pos('*',wor)>0 then
begin
ll:=pos('*',wor);
if wor[ll+1]='*' then
 begin
  kere:='Q';
  wor:=copy(wor,1,ll-1)+copy(wor,3,length(wor)-2);
 end
else
 begin
  kere:='K';
  wor:=copy(wor,1,ll-1)+copy(wor,2,length(wor)-1);
 end;
end;


i:=j+1;
if pos('%',s)=0 then
 j:=pos('@',copy(s,i,length(s)-i+1))+i-1
else
 j:=pos('%',copy(s,i,length(s)-i+1))+i-1;
lem:=copy(s,i,j-i);

morf:=copy(s,j,length(s)-i+1);
end;
end;

{==============================================================}
{==============================================================}
{==============================================================}

function transf(s:string):string;
var i:byte;
    ou:string;

begin
ou:='';
for i:= 1 to length(s) do
case s[i] of
'(':ou:=ou+'`';
')':ou:=ou+'''';
'X':ou:=ou+'Ch';
'+':ou:=ou+'Th';
'Y':ou:=ou+'J';
'$':ou:=ou+'Sh';
'&':ou:=ou+'Ss';
'#':ou:=ou+'Sz';
'A':ou:=ou+'a';
'F':ou:=ou+' ';
'E':ou:=ou+'e';
'"':ou:=ou+'‚';
'I':ou:=ou+'i';
'U':ou:=ou+'u';
'O':if i<length(s) then
     begin
     if s[i+1]='W'then
      begin
      ou:=ou+'O';
      i:=i+1;
      end
     else
      ou:=ou+'o'
     end;
'^':;
'~':;
'/':;
else
ou:=ou+s[i];
end;
transf:=ou;
end;


function deco(var ww:w):string;
var s,ou:string;
    i:byte;


procedure g_;
begin
i:=i+1;
case s[i] of
'm':ou:=ou+'m.';
'f':ou:=ou+'f.';
'b':;
'c':{ou:=ou+'c.'};
end;
i:=i+1;
case s[i] of
's':ou:=ou+'sg.';
'p':ou:=ou+'pl.';
'd':ou:=ou+'du.';
end;
end;

procedure pg_;
begin
i:=i+1;
ou:=ou+s[i]+'.';
g_;
ou:=ou+' ';
end;

procedure g_s;
begin
g_;
if i<length(s) then begin
 if (s[i+1]='c') or (s[i+1]='d') then
  begin
  i:=i+1;
  case s[i] of
 'c':ou:=ou+'cs. ';
 'd':ou:=ou+'det. ';
  else
   ou:=ou+'abs. ';
  end;
  end
 else
   ou:=ou+'abs. ';
  end
 else
   ou:=ou+'abs. ';
end;


begin
ww.st:='O';
ou:='';
s:=ww.morf;
i:=1;
if s[i]='@' then
 ww.langu:='H'
else
 ww.langu:='A';
i:=i+1;;
case s[i] of
'x':ou:=ou+'Pargraph divider';

'P':begin
    i:=i+1;
    case s[i] of
 'a':if ww.langu='H' then ou:=ou+'Art. '
                     else ww.st:='A';
 'c':ou:=ou+'Conj. ~'+transf(ww.lem)+'~ ';
 'd':ou:=ou+'Adv. ~'+transf(ww.lem)+'~ ';
 'g':ou:=ou+'Interrog. ~'+transf(ww.lem)+'~ ';
 'i':ou:=ou+'Interj. ~'+transf(ww.lem)+'~ ';
 'n':ou:=ou+'Neg. Part. ~'+transf(ww.lem)+'~ ';
 'o':ou:=ou+'Nota Acc. ~'+transf(ww.lem)+'~ ';
 'p':begin
     ou:=ou+'Prep. ~'+transf(ww.lem)+'~ ';
      if i<length(s) then
       if (s[i+1]='+') then
        if (s[i+2]='P') then
         if (s[i+3]='a') then
          begin
          i:=i+3;
          ou:=ou+'+ Art. ';
          end;
     end;
 'r':ou:=ou+'Nota relativi ';
    end;
    end;

'p':begin
    i:=i+2;
    if s[i]='i' then ou:=ou+'Interrog. '
      else
       begin
        i:=i-1;
        ou:=ou+'Pron. '{,'~'+transf(ww.lem)+'~ '};
        pg_;
       end;
    end;

{    ..  Noun  ..      }
'n':begin
    i:=i+1;
    case s[i] of
 'p':ou:=ou+'PN ';
 'g':ou:=ou+'GN ';
 'c':begin
   ou:=ou+'~'+transf(ww.lem)+'~ ';
   g_s;
     end;
    end;
    end;

{    ..   ADJ   ..   }
'a':begin
    ou:=ou+'Adj. ~'+transf(ww.lem)+'~ ';
    g_s;
    end;

{    .. VERB ..      }
'v':begin
    ou:=ou+'~'+transf(ww.lem)+'~ ';
    i:=i+1;
    ou:=ou+'';
    case s[i] of
 'q':ou:=ou+'qal ';
 'n':ou:=ou+'ni ';
 'p':ou:=ou+'pi ';
 'P':if ww.langu='H' then
  ou:=ou+'pual '
     else
  ou:=ou+'pol ';
 't':ou:=ou+'hit ';
 'h':ou:=ou+'hi ';
 'Q':if ww.langu='H' then
  ou:=ou+'pas. qal '
     else
  ou:=ou+'saph ';
 'H':if ww.langu='H' then
  ou:=ou+'ho '
     else
  ou:=ou+'hish ';
 'A':ou:=ou+'aph ';
 'B':ou:=ou+'haph ';
 'C':ou:=ou+'heph ';
 'D':ou:=ou+'hoph ';
 'E':ou:=ou+'htap ';
 'F':ou:=ou+'htpe ';
 'G':ou:=ou+'htpo ';
 'I':ou:=ou+'ish ';
 'J':ou:=ou+'ith ';
 'K':ou:=ou+'itpa ';
 'L':ou:=ou+'itpe ';
 'M':ou:=ou+'pael ';
 'N':ou:=ou+'peal ';
 'O':ou:=ou+'peil ';
 'R':ou:=ou+'shap ';
 'S':ou:=ou+'htpa ';
    end;
    ou:=ou+'';

    i:=i+1;
    case s[i] of
  'p':begin
      ou:=ou+'perf. ';
      pg_;
      end;
  'i':begin
      ou:=ou+'impf. ';
      pg_;
      end;
  'w':begin
      ou:=ou+'nar. ';
      ww.st:='N';
      pg_;
      end;
  'v':begin
      ou:=ou+'impt. ';
      g_;
      ou:=ou+' ';
      end;
  'P':begin
      ou:=ou+'pt. ';
      g_s;
      end;
  's':begin
      ou:=ou+'pt.pas. ';
      g_s;
      end;
  'c':ou:=ou+'inf.cs. ';
  'a':ou:=ou+'inf.abs. ';
    end;
    end;
end;

while (i<length(s)) do
begin
i:=i+1;
case s[i] of
'j':ou:=ou+'i.p. ';
'h':ou:=ou+'+ ~H~ cohort. ';
'X':begin
    i:=i+1;
    case s[i] of
 'h':ou:=ou+'+ ~H~ parag. ';
 'd':ou:=ou+'+ ~H~ loc. ';
 'n':ou:=ou+'+ ~N~ parag. ';
    else
    i:=i-1;
     begin
     ou:=ou+'+ Suff. ';
     pg_;
     end;
    end;
    end;
else
  ou:=ou+'?';
end;
end;

deco:=ou;
end;

{==============================================================}
{==============================================================}
{==============================================================}

function upcas(ch:char):char;
var i:char;
begin
if config_upcas then
begin
case ch of
'a'..'z':i:=chr(ord(ch)-32);
' ':i:='�';
'‚':i:='�';
'¡':i:='‹';
'¢':i:='•';
'£':i:='—';
'¨':i:='›';
end;
upcas:=i;
end
else upcas:=ch;
end;

function trans_hs(s:string):string;
var i:byte;
    t:string;
begin
t:='';
for i:=1 to length(s) do
 if s[i] in souhl then
  t:=t+s[i];
trans_hs:=t;
end;

function trans_cz(s:string):string;
var i:byte;
    ou:string;

begin
ou:='';
for i:= 1 to length(s) do
case s[i] of
'(':ou:=ou+'`';
')':ou:=ou+'''';
'X':ou:=ou+'Ch';
'+':ou:=ou+'Th';
'Y':ou:=ou+'J';
'$':ou:=ou+'Sh';
'&':ou:=ou+'Ss';
'#':ou:=ou+'Sz';
'A':ou:=ou+'a';
'F':ou:=ou+' ';
'E':ou:=ou+'e';
'"':ou:=ou+'‚';
'I':ou:=ou+'i';
'U':ou:=ou+'u';
'O':if i<length(s) then
     begin
     if s[i+1]='W'then
      begin
      ou:=ou+'O';
      i:=i+1;
      end
     else
      ou:=ou+'o'
     end;
'^':;
'~':;
'/':;
else
ou:=ou+s[i];
end;
trans_cz:=ou;
end;

function trans_sh(s:string):string;
var i:byte;
    ou:string;

begin
ou:='';
for i:= 1 to length(s) do
case s[i] of
'(':ou:=ou+'ajin ';
')':ou:=ou+' l‚f ';
'X':ou:=ou+'chet ';
'+':ou:=ou+'tet ';
'Y':ou:=ou+'j¢d ';
'$':ou:=ou+'¨in ';
'&':ou:=ou+'sin ';
'#':ou:=ou+'¨in ';
'B':ou:=ou+'b‚t ';
'G':ou:=ou+'gimel ';
'D':ou:=ou+'d let ';
'H':ou:=ou+'h‚ ';
'W':ou:=ou+'vav ';
'Z':ou:=ou+'zajn ';
'K':ou:=ou+'kaf ';
'L':ou:=ou+'l med ';
'M':ou:=ou+'m‚m ';
'N':ou:=ou+'n£n ';
'S':ou:=ou+'s mek ';
'P':ou:=ou+'p‚ ';
'C':ou:=ou+'c de ';
'Q':ou:=ou+'k¢f ';
'R':ou:=ou+'r⬠';
'T':ou:=ou+'t v ';

end;
trans_sh:=ou;
end;

function trans_sm(s:string):string;
var i:byte;
    ou:string;

begin
ou:='';
for i:= 1 to length(s) do
case s[i] of
'(':ou:=ou+'ajin ';
')':ou:=ou+' l‚f ';
'X':ou:=ou+'chet ';
'+':ou:=ou+'tet ';
'Y':ou:=ou+'j¢d ';
'$':ou:=ou+'¨in ';
'&':ou:=ou+'sin ';
'#':ou:=ou+'¨in ';
'B':ou:=ou+'b‚t ';
'G':ou:=ou+'gimel ';
'D':ou:=ou+'d let ';
'H':ou:=ou+'h‚ ';
'W':ou:=ou+'vav ';
'Z':ou:=ou+'zajn ';
'K':ou:=ou+'kaf ';
'L':ou:=ou+'l med ';
'M':ou:=ou+'m‚m ';
'N':ou:=ou+'n£n ';
'S':ou:=ou+'s mek ';
'P':ou:=ou+'p‚ ';
'C':ou:=ou+'c de ';
'Q':ou:=ou+'k¢f ';
'R':ou:=ou+'r⬠';
'T':ou:=ou+'t v ';

'A':ou:=ou+'patach ';
'F':ou:=ou+'k mec ';
'I':ou:=ou+'ch¡rek ';
'E':ou:=ou+'seg¢l ';
'"':ou:=ou+'c‚r‚ ';
'O':ou:=ou+'ch¢lem ';
'U':ou:=ou+'kibuc ';
':':ou:=ou+'¨eva ';
'.':ou:=ou+'dage¨ ';

{'-':ou:=ou+'makef ';}

end;
trans_sm:=ou;
end;

  { rozdeli slovo na jednotlive souhlasky & spol.}
  { i: zacatek segmentu;
    vystup: konec segmentu }

function syl (s:string; i:byte): byte;
var j:byte;
begin
j:=i;
if s[j]='^' then j:=j+1; { BUG FIX }
repeat
j:=j+1;
until ((j>length(s)) or (s[j] in souhl));
j:=j-1;
syl:=j;
end;

  { analyzuje jeden segment (=souhlaska & spol.) }
  { f: zacatek segmentu (offset v s:string) }
  { t: konec segmentu (offset v s:string) }
  { an: record > vysledna analyza }

procedure anl1 (s:string;f, t:byte; var an:analys1);
var i:byte;
 begin
 with an do
begin
sou:=' ';sam:=' ';dag:=false;acc:=false;she:=false;delk:=0;
i:=f;
while (i<=t) do
 begin
 case s[i] of
 ':':she:=true;
 '.':dag:=true;
 '^':acc:=true;
 else
  if s[i] in souhl then sou:=s[i] else
  if s[i] in samohl then sam:=s[i];
 end;
  i:=i+1;
 end;
end;
 end;

   {zjisti, jestli k segmentu patri dalsi jakozto podklad}

function podklad(s:string;i:byte;var an:analys1):byte;
var j,jj,k,last:byte;
    an1,an2:analys1;
begin
with an do
 begin
 j:=syl(s,i); {najde konec prvniho segmentu }
 anl1(s,i,j,an);  {a zanalyzuje}
 last:=j;
if not (she or (j=length(s))) then {je to segment se ¨evou, nebo posledn¡ s. ?}
 begin     {neni, zkus, jestli dalsi souhl ska nen¡ podkladem}
 k:=j+1;
 j:=syl(s,k);                               {najde konec dalsiho segmentu }
 anl1(s,k,j,an1);                                {a zanalyzuje}
 if (an1.sam=' ') and not (an1.she) then
 case an1.sou of                               {vyzhousej jednotlive podklady}
 ')':if sam<>' ' then
        begin delk:=2; last:=j; acc:=acc or an1.acc end;
 'Y':if sam in ['E','"','I'] then
        begin delk:=2; last:=j; acc:=acc or an1.acc end
      else if (sam='F') and (an1.sou='Y') and (j<length(s)) then
        begin
        jj:=syl(s,j+1);
        anl1(s,j+1,jj,an2);
        if (jj=length(s)) and (an2.sou='W') then
         begin delk:=2; last:=j; acc:=acc or an1.acc end;
        end;
 'W':begin
     if sam='O' then
        begin delk:=2; last:=j; acc:=acc or an1.acc end;
     if (sam=' ') and an1.dag then
        begin sam:='U'; delk:=2; last:=j; acc:=acc or an1.acc end;
     end;
 'H':if (j=length(s)) and (sam in ['F','E','"','O']) then
        begin delk:=2; last:=j; acc:=acc or an1.acc end;
 end;
 end;
 podklad:=last;
 end;
end;

      {najde v retezci slabiku od daneho offsetu a zanalyzuje }
     { f: zacatek slabiky (offset) }
     { an: record > vysledna analyza }
     { vysledek : konec slabiky (offset) }


function anl(s:string; f:byte;var  an:analys2):byte;
var i,last:byte;
    an1,an2:analys1;

 begin
 with an do
begin
sou1:=' '; sou2:=' '; sam:=' ';
dag1:=false; dag2:=false; she:=false; acc:=false;
delk:=0; uzav:=false; furt:=false; upc:=false; upc_n:=false;

i:=podklad(s,f,an1);  {vezme a zanalyzuje prvni segment}

sou1:=an1.sou;
dag1:=an1.dag;
acc:=an1.acc;  { vezme prizvuk, je-li }
she:=an1.she;
sam:=an1.sam;
last:=i;
if she or (i=length(s)) then  {je to segment se ¨evou, nebo posledn¡ s. ?}
 begin
  uzav:=false;      {ano, rozhodnˆ se tedy nejedn  o uzav©enou sl.}
  delk:=3;   {je to pokud mo‘no dloh  samohl ska}
  if she and (sam=' ') then upc_n:=true;
  if (i=length(s)) and (sou1='X') then furt:=true;
  if (i=length(s)) and (sou1='H') and dag1 then furt:=true;
     {patah furtivum}
 end
else                { ne, tedy mus¡me prozkoumat dal¨¡ segment }
 begin
 i:=podklad(s,i+1,an2);
 if not(an2.sam in samohl) then {stoji u dalsi souhl. samohl? }
  begin  {ne, tak je to uzavrena slabika}
  uzav:=true;
  sou2:=an2.sou;
  dag2:=an2.dag;
  acc:=acc or an2.acc;
  if not acc then delk:=1;
  last:=i;
  end;
 if an2.dag and (sam in samohl) then {je v dalsi souhl. dage¨ forte ?}
  begin  {ano, je to uzavrena slabika}
  uzav:=true;
  sou2:=an2.sou;
  dag2:=an2.dag;
  upc_n:=true;  {Pismeno bude UPCASE kvuli hlasovemu vystupu }
  if not acc then delk:=1;
  end;
 end;
anl:=last;
end;
 end;

procedure clean_anl(an:analys2);
begin
with an do begin
sou1:=' '; sou2:=' '; sam:=' ';
dag1:=false; dag2:=false; she:=false; acc:=false;
delk:=0; uzav:=false; furt:=false; upc:=false; upc_n:=false;
end;
end;

function rekni_s(ch:char;dages,furt:boolean;var upc:boolean):string;
var o,od:string;
    d:boolean;

begin
d:=false;
case ch of
'(':begin o:=''; if config_upc_a and not(furt) then upc:=true; end;
')':begin o:=''; if config_upc_a then upc:=true; end;
'X':o:='ch';
'+':o:='t';
'Y':o:='j';
'$':o:='¨';
'&':o:='s';
'#':o:='¨';
'B':begin o:='v'; od:='b'; d:=true; end;
'G':o:='g';
'D':o:='d';
'H':o:='h';
'W':begin o:='v'; od:='£'; d:=true; end;
'Z':o:='z';
'K':begin o:='ch'; od:='k'; d:=true; end;
'L':o:='l';
'M':o:='m';
'N':o:='n';
'S':o:='s';
'P':begin o:='f'; od:='p'; d:=true; end;
'C':o:='c';
'Q':o:='k';
'R':o:='r';
'T':o:='t';

end;
if dages and d then rekni_s:=od else rekni_s:=o;
end;

function rekni_sm(ch:char;delk:byte):string;
var d,k,p:string;
begin
p:='';d:='';k:='';
case ch of
'A':begin p:='a'; d:='a'; k:='a'; end;
'F':begin p:=' '; d:=' '; k:='o'; end;
'E':begin p:='‚'; d:='e'; k:='e'; end;
'"':begin p:='‚'; d:='‚'; k:='‚'; end;
'I':begin p:='¡'; d:='¡'; k:='i'; end;
'O':begin p:='¢'; d:='¢'; k:='¢'; end;
'U':begin p:='£'; d:='£'; k:='u'; end;
end;
case delk of
0,3:rekni_sm:=d;   {vetsinou dlouhe }
1:rekni_sm:=k; {vzdy kratke}
2:rekni_sm:=p; {podklad (vzdy dlouhe) }
end;
end;

function rekni(an,an_l:analys2):string;
var s:string;
    b:boolean;
begin
with an do
 begin
 s:='';
if furt then  s:=s+rekni_sm(sam,delk);
 s:=s+rekni_s(sou1,dag1,furt,upc);
if not(furt) then  s:=s+rekni_sm(sam,delk);
 if uzav then s:=s+rekni_s(sou2,dag2,furt,b);
 end;
 if an.upc or an_l.upc_n then s[1]:=upcas(s[1]);
 rekni:=s;
end;

function fonetic(s:string):string;
var i:byte;
    an,an1:analys2;
    t:string;
begin
if trans_hs(s)='YHWH' then fonetic:='Ad¢naj'
else begin
i:=0;
clean_anl(an1);
t:='';
repeat
 i:=i+1;
 i:=anl(s,i,an);
 t:=t+rekni(an,an1);
 an1:=an;
until (i>=length(s)) ;
fonetic:=t;
end;
end;

    {**************************************************}

procedure Tloader.init;
begin
buffer:='';
bfpos:=0;
bfres:=1;
ef:=false;
end;

function Tloader.readbf(var f:file):char;
begin
if bfpos=0 then
  begin
   blockread(f,bf,1024,bfres);
   if bfres>0 then bfpos:=1 else ef:=true;
  end;
if (bfpos<=1024) and (bfpos>0) then
  begin
   readbf:=bf[bfpos];
   bfpos:=bfpos+1;
  end;
if (bfpos>1024) then
  begin
   blockread(f,bf,1024,bfres);
   if bfres>0 then bfpos:=1 else ef:=true;
  end;
end;

function Tloader.eof:boolean;
begin
eof:=ef;
end;


function Tloader.readstr(var f:file):string;
var i:char;
    s:string;
begin
i:=#0;
s:='';
while not(eof or (i=#10)) do
begin
 i:=readbf(f);
 if not(i in [#10,#13]) then s:=s+i;
end;
readstr:=s;
end;

procedure Tloader.findchap(ch:byte;var f:file);
{! nutno pouzit hned po otevreni souboru !!!!}
var s,t:string;
begin
str(ch,t);
t:=t+':1';
while not(eof or ((s[1]='>') and (copy(s,4,length(s)-3)=t))) do
  begin
  s:=readstr(f);
  if (s[1]='>') and (copy(s,5,length(s)-4)=':1') then write('.');
  if (s[1]='>') and (copy(s,6,length(s)-5)=':1') then write('.');
  end;
chap_pos:=FilePos(f);
end;

procedure Tloader.seekchap(var f:file);
begin
seek(f,chap_pos);
buffer:='';
end;

function Tloader.loadlin(var f:file):string;
var s,t:string;
    ww:w;
    i,j,k:byte;
    a:char;
begin
repeat
if buffer<>'' then begin s:=buffer; buffer:=''; end
 else begin s:=readstr(f);
       if s[1]='>' then s:=readstr(f);
      end;
divi(s,ww);
nm[1]:=ww.num[1];nm[2]:=ww.num[2];nm[3]:=ww.num[3];
t:='';
i:=ww.num[3];j:=ww.num[2];k:=ww.num[1];
while not(eof or (i<>ww.num[3]) or (j<>ww.num[2])
          or (k<>ww.num[1]) or (t[length(t)]='-')) do
begin
t:=t+ww.wor;
s:=readstr(f);
if s[1]='>' then s:=readstr(f);
nm[1]:=ww.num[1];nm[2]:=ww.num[2];nm[3]:=ww.num[3];
divi(s,ww);
end;
buffer:=s;
until (t<>'');
loadlin:=t;
end;

    {**************************************************}
    {**************************************************}
    {**************************************************}
    {**************************************************}

begin
end.