278 lines
11 KiB
Ada
278 lines
11 KiB
Ada
with Text_Io;
|
|
with Strings_Package; use Strings_Package;
|
|
with Latin_File_Names; use Latin_File_Names;
|
|
with Inflections_Package; use Inflections_Package;
|
|
with Dictionary_Package; use Dictionary_Package;
|
|
with Word_Support_Package; use Word_Support_Package;
|
|
|
|
procedure MAKESTEM is
|
|
use Integer_Io;
|
|
use STEM_KEY_TYPE_IO;
|
|
use COUNT_IO;
|
|
use Text_IO;
|
|
use STEM_IO;
|
|
use MNPC_IO;
|
|
use Part_Entry_IO;
|
|
|
|
D_K : Dictionary_Kind := XXX; -- ######################
|
|
|
|
|
|
I : STEM_IO.COUNT := 0;
|
|
Line, Blanks : String(1..200) := (others => ' ');
|
|
Last, Ll : Integer := 0;
|
|
M : STEM_IO.Positive_Count := 1;
|
|
Ds : Dictionary_Stem;
|
|
Fc, Ofc : Character := ' ';
|
|
Sc, Osc : Character := ' ';
|
|
|
|
procedure Put_Indices(Ch : String;
|
|
D_K : Dictionary_Kind) is
|
|
Wd : String(1..2) := Ch(1..2);
|
|
begin
|
|
--Put_Line("Put_Indices");
|
|
if Ch = " " then
|
|
if (Bblf(Ch(1), Ch(2), D_K) > 0) and then
|
|
(Bbll(Ch(1), Ch(2), D_K) >= Bblf(Ch(1), Ch(2), D_K)) then
|
|
Put("CH = ("); Put(Ch); Put(") index is of range ");
|
|
Put(Bblf(Ch(1), Ch(2), D_K)); Put(".."); Put(Bbll(Ch(1), Ch(2), D_K));
|
|
Put(" number ");
|
|
Put(Bbll(Ch(1), Ch(2), D_K) - Bblf(Ch(1), Ch(2), D_K) + 1);
|
|
New_Line;
|
|
end if;
|
|
elsif Ch(2) = ' ' then
|
|
if (Bdlf(Ch(1), Ch(2), D_K) > 0) and then
|
|
(Bdll(Ch(1), Ch(2), D_K) >= Bdlf(Ch(1), Ch(2), D_K)) then
|
|
Put("CH = ("); Put(Ch); Put(") index is of range ");
|
|
Put(Bdlf(Ch(1), Ch(2), D_K)); Put(".."); Put(Bdll(Ch(1), Ch(2), D_K));
|
|
Put(" number ");
|
|
Put(Bdll(Ch(1), Ch(2), D_K) - Bdlf(Ch(1), Ch(2), D_K) + 1);
|
|
New_Line;
|
|
end if;
|
|
else
|
|
if (First_Index(Wd, D_K) > 0) and then
|
|
(Last_Index(Wd, D_K) >= First_Index(Wd, D_K)) then
|
|
Put("CH = ("); Put(Wd); Put(") index is of range ");
|
|
Put(First_Index(Wd, D_K)); Put(".."); Put(Last_Index(Wd, D_K));
|
|
Put(" number ");
|
|
Put(Last_Index(Wd, D_K) - First_Index(Wd, D_K) + 1);
|
|
New_Line;
|
|
end if;
|
|
end if;
|
|
end Put_Indices;
|
|
|
|
begin
|
|
Put_Line("Creates STEMFILE.D_K and INDXFILE.D_K from STEMLIST.D_K");
|
|
|
|
Put("What dictionary to load, GENERAL or SPECIAL =>");
|
|
Get_Line(Line, Last);
|
|
if Last > 0 then
|
|
if Trim(Line(1..Last))(1) = 'G' or else
|
|
Trim(Line(1..Last))(1) = 'g' then
|
|
D_K := General;
|
|
elsif Trim(Line(1..Last))(1) = 'S' or else
|
|
Trim(Line(1..Last))(1) = 's' then
|
|
D_K := Special;
|
|
else
|
|
Put_Line("No such dictionary");
|
|
raise Text_Io.Data_Error;
|
|
end if;
|
|
end if;
|
|
|
|
Open( STEM_List(D_K), In_File,
|
|
Add_File_Name_Extension(STEM_List_Name,
|
|
Dictionary_Kind'Image(D_K)));
|
|
|
|
Create(STEM_File(D_K), Inout_File,
|
|
Add_File_Name_Extension(STEM_File_Name,
|
|
Dictionary_Kind'Image(D_K)));
|
|
|
|
Create(Indx_File(D_K), Out_File,
|
|
Add_File_Name_Extension(Indx_File_Name,
|
|
Dictionary_Kind'Image(D_K)));
|
|
|
|
------------------------------------------------------------------
|
|
|
|
-- This section assumes the blank ESSE stem is first - D_K GENERAL
|
|
if D_K = General then
|
|
I := I + 1;
|
|
Bblf(' ', ' ', General) := I;
|
|
Bbll(' ', ' ', General) := 0;
|
|
Line := Blanks;
|
|
Get_Line(STEM_List(D_K), Line, Last);
|
|
PUT_LINE(LINE(1..LAST));
|
|
|
|
Fc := Line(1);
|
|
Sc := Line(2);
|
|
Ds.Stem := Line(1..Max_Stem_Size);
|
|
--PUT_LINE("#" & LINE(MAX_STEM_SIZE+1..LAST));
|
|
Get(Line(Max_Stem_Size+1..Last), Ds.Part, Ll);
|
|
--PUT(DS.PART); NEW_LINE;
|
|
--PUT_LINE("#" & LINE(LL+1..LAST));
|
|
Get(Line(Ll+1..Last), Ds.Key , Ll);
|
|
--PUT(DS.KEY ); NEW_LINE;
|
|
--PUT_LINE("#" & LINE(LL+1..LAST));
|
|
Get(Line(Ll+1..Last), Ds.mnpc , Ll);
|
|
--PUT(DS.AAMNPC); NEW_LINE;
|
|
Write(STEM_File(D_K), Ds);
|
|
Bbll(Fc, Sc, General) := I; -- 1
|
|
|
|
Put(Indx_File(D_K), " ");
|
|
Put(Indx_File(D_K), ' ');
|
|
Put(Indx_File(D_K), Bblf(' ', ' ', General));
|
|
Put(Indx_File(D_K), ' ');
|
|
Put(Indx_File(D_K), Bbll(' ', ' ', General));
|
|
Put(Indx_File(D_K), ' ');
|
|
New_Line(Indx_File(D_K));
|
|
|
|
Put_Indices(" ", General);
|
|
|
|
end if;
|
|
------------------------------------------------------------------
|
|
|
|
Fc := 'a';
|
|
Ofc := 'a';
|
|
Sc := ' ';
|
|
Osc := ' ';
|
|
Bdlf(Ofc, ' ', D_K) := I + 1;
|
|
--DEBUG.PUT(" bf1 BDLF("); DEBUG.PUT(OFC);
|
|
--DEBUG.PUT(' '); DEBUG.PUT(") "); DEBUG.PUT(BDLF(OFC, ' ', D_K));
|
|
--DEBUG.NEW_LINE;
|
|
|
|
First_Character_Loop:
|
|
while not End_Of_File(STEM_List(D_K)) loop
|
|
--OSC := ' ';
|
|
Osc := Sc;
|
|
Second_Character_Loop:
|
|
while not End_Of_File(STEM_List(D_K)) loop
|
|
|
|
Inner_Loop:
|
|
while not End_Of_File(STEM_List(D_K)) loop
|
|
Line := Blanks;
|
|
Get_Line(STEM_List(D_K), Line, Last);
|
|
--Put_Line("* " & Line(1..Last));
|
|
|
|
if Trim(Line(1..Last)) = "" then Put_Line("Trim(Line(1..Last)) BLANK"); end if;
|
|
exit First_Character_Loop when Trim(Line(1..Last)) = "";
|
|
Fc := Lower_Case(Line(1));
|
|
Sc := Lower_Case(Line(2));
|
|
--------------------------------------------------------------------
|
|
if Fc = 'v' then Fc := 'u'; end if;
|
|
if Sc = 'v' then Sc := 'u'; end if;
|
|
if Fc = 'j' then Fc := 'i'; end if;
|
|
if Sc = 'j' then Sc := 'i'; end if;
|
|
--------------------------------------------------------------------
|
|
I := I + 1;
|
|
|
|
if Sc = ' ' then
|
|
--Put("BDL I -> "); Put(I ); New_Line;
|
|
if Fc /= Ofc then
|
|
Bdlf(Fc, ' ', D_K) := I;
|
|
--Put(" bf2 BDLF("); Put(Fc);Put(' '); Put(") ");
|
|
--Put(Bdlf(Fc, ' ', D_K)); New_Line;
|
|
end if;
|
|
else
|
|
null;
|
|
--Put("I -> "); Put(I); New_Line;
|
|
end if;
|
|
|
|
Ds.Stem := Line(1..Max_Stem_Size);
|
|
Get(Line(Max_Stem_Size+1..Last), Ds.Part, Ll);
|
|
Get(Line(Ll+1..Last), Ds.Key , Ll);
|
|
Get(Line(Ll+1..Last), Ds.mnpc , Ll);
|
|
Write(STEM_File(D_K), Ds);
|
|
--Put_Line("Wrote STEMfile");
|
|
|
|
if Fc /= Ofc then -- Jumped FC, effectively must have jumped a SC
|
|
--Put_Line("Jumped FC");
|
|
if Osc = ' ' then
|
|
Bdll(Ofc, Osc, D_K) := I - 1;
|
|
else
|
|
Ddll(Ofc, Osc, D_K) := I - 1;
|
|
end if;
|
|
|
|
if Sc = ' ' then
|
|
--Put("BDLF "); Put(Bdlf(Fc, Sc, D_K)); New_Line;
|
|
Bdlf(Fc, Sc, D_K) := I;
|
|
else
|
|
Ddlf(Fc, Sc, D_K) := I;
|
|
end if;
|
|
--Put_Line("if Sc done");
|
|
--Put("Ofc = '"); Put(Ofc); Put("' Osc = '"); Put(Osc); Put_Line("'");
|
|
Put_Indices(Ofc & Osc, D_K);
|
|
Ofc := Fc;
|
|
Osc := Sc;
|
|
--Put_Line("exit Second_Character_Loop");
|
|
|
|
exit Second_Character_Loop;
|
|
else
|
|
if Sc /= Osc then -- Jumped a SC, but not a FC
|
|
if Osc = ' ' then -- Jumped a SC from ' ' to something
|
|
Bdll(Fc, Osc, D_K) := I - 1; -- So set BDLL
|
|
--DEBUG.PUT(" bl1 BDLL("); DEBUG.PUT(FC); DEBUG.PUT(OSC); DEBUG.PUT(") ");
|
|
--DEBUG.PUT(BDLL(FC, OSC, D_K)); DEBUG.NEW_LINE;
|
|
Ddlf(Fc, Sc, D_K) := I;
|
|
--DEBUG.PUT(" df1 DDLF("); DEBUG.PUT( FC); DEBUG.PUT( SC); DEBUG.PUT(") ");
|
|
--DEBUG.PUT(DDLF( FC, SC, D_K)); DEBUG.NEW_LINE;
|
|
Put_Indices(Fc & Osc, D_K);
|
|
Osc := Sc;
|
|
|
|
exit Inner_Loop;
|
|
else -- Jumped a SL from something, not ' '
|
|
Ddll(Fc, Osc, D_K) := I - 1; -- So set DDLL
|
|
--DEBUG.PUT(" dl2 DDLL("); DEBUG.PUT(FC); DEBUG.PUT(OSC); DEBUG.PUT(") ");
|
|
--DEBUG.PUT(DDLL(FC, OSC, D_K)); DEBUG.NEW_LINE;
|
|
Ddlf(Fc, Sc, D_K) := I;
|
|
--DEBUG.PUT(" df2 DDLF("); DEBUG.PUT( FC); DEBUG.PUT( SC); DEBUG.PUT(") ");
|
|
--DEBUG.PUT(DDLF( FC, SC, D_K)); DEBUG.NEW_LINE;
|
|
Put_Indices(Fc & Osc, D_K);
|
|
Osc := Sc;
|
|
|
|
exit Inner_Loop;
|
|
end if;
|
|
end if;
|
|
end if;
|
|
|
|
|
|
|
|
end loop Inner_Loop;
|
|
--Put_Line("Exitted Inner_Loop");
|
|
|
|
end loop Second_Character_Loop;
|
|
--Put_Line("Exitted Second_Character_Loop");
|
|
|
|
end loop First_Character_Loop;
|
|
--Put_Line("Exitted First_Character_Loop");
|
|
Ddll(Ofc, Osc, D_K) := I;
|
|
|
|
-- To reprint correctly the last letter information
|
|
--Put_Line("-- To reprint correctly the last letter information");
|
|
Put_Indices(Ofc & Osc, D_K);
|
|
Close(STEM_File(D_K));
|
|
|
|
|
|
for I in Character'('a')..Character'('z') loop
|
|
for J in Character'(' ')..Character'(' ') loop
|
|
Text_Io.Put(Indx_File(D_K), (I, J));
|
|
Put(Indx_File(D_K), ' ');
|
|
Put(Indx_File(D_K), Bdlf(I, J, D_K));
|
|
Put(Indx_File(D_K), ' ');
|
|
Put(Indx_File(D_K), Bdll(I, J, D_K));
|
|
Put(Indx_File(D_K), ' ');
|
|
New_Line(Indx_File(D_K));
|
|
end loop;
|
|
end loop;
|
|
for I in Character'('a')..Character'('z') loop
|
|
for J in Character'('a')..Character'('z') loop
|
|
Text_Io.Put(Indx_File(D_K), (I, J));
|
|
Put(Indx_File(D_K), ' ');
|
|
Put(Indx_File(D_K), Ddlf(I, J, D_K));
|
|
Put(Indx_File(D_K), ' ');
|
|
Put(Indx_File(D_K), Ddll(I, J, D_K));
|
|
Put(Indx_File(D_K), ' ');
|
|
New_Line(Indx_File(D_K));
|
|
end loop;
|
|
end loop;
|
|
Close(Indx_File(D_K));
|
|
|
|
end MAKESTEM;
|