import from .zip file
This commit is contained in:
Michael Wolf
277
makestem.adb
Normal file
277
makestem.adb
Normal file
@@ -0,0 +1,277 @@
|
||||
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;
|
||||
Reference in New Issue
Block a user