unit EORFO;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TOrfoBox = class(TForm)
    eW: TEdit;
    btExit: TButton;
    btAdd: TButton;
    btDel: TButton;
    ProgressBarOE: TProgressBar;
    Button1: TButton;
    Label1: TLabel;
    btLoad: TButton;
    OpenDialog1: TOpenDialog;
    procedure FormActivate(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure DelButtonClick(Sender: TObject);
    procedure ExitButtonClick(Sender: TObject);
    procedure ESCButtonClick(Sender: TObject);
    procedure LoadButtonClick(Sender: TObject);
    procedure EditKeyPress(Sender: TObject; var Key: char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  OrfoBox: TOrfoBox;

implementation

uses Unit1, MyFunc;

{$R *.dfm}

var
    ZZZ: TStringList;       {временная хеш-таблица}
    Orfo: TStringList;      {орфоттаблица}
    Slovo: TStringList;     {список словоформ для корректировки орфотаблицы}
    Batch: boolean = False;
    sName: string = '';     {имя файла словоформ}
    ts: integer;            {размер хеш-таблицы}

procedure TOrfoBox.EditKeyPress(Sender: TObject; var Key: char);
begin
  if not (Key in ['а'..'я','А'..'Я', 'ё','Ё',#8]) then Key := #0;
end;


procedure TOrfoBox.FormActivate(Sender: TObject);
var
  i, i0: integer;
begin
  Slovo := TStringList.Create;
  Orfo := TStringList.Create;
  if FileExists(Form1.StartDir+'\~orfo~') then begin
    Orfo.LoadFromFile(Form1.StartDir+'\~orfo~');
    {Чистая эмпирика. Можно просто взять 300000 - зело довольно :)}
    ts := FirstSimpleAfter(2*(Orfo.Count+125000));
  end;
  zzz := TStringList.Create;
  for i := 0 to ts-1 do zzz.Add('');
  for i := 0 to Orfo.Count-1 do begin
    HFind(zzz,FirstWord(Orfo[i]),ts,i0);
    zzz[i0] := Orfo[i];
  end;
  OrfoBox.eW.Text := '';
  OrfoBox.eW.SetFocus;
end;


procedure TOrfoBox.FormDeactivate(Sender: TObject);
begin
  if zzz <> nil then FreeAndNil(zzz);
  if Orfo <> nil then FreeAndNil(Orfo);
  if Slovo <> nil then FreeAndNil(Slovo);
end;


procedure TOrfoBox.AddButtonClick(Sender: TObject);
var
  c, b, cod: string;
  j, m, n, i, i0: integer;
begin
  try
    if (not Batch) then if (Slovo.Count = 0) then Slovo.Add(OrfoBox.eW.Text)
                                             else Slovo[0] := OrfoBox.eW.Text;
    n := Slovo.Count;
    ProgressBarOE.Min := 0;
    ProgressBarOE.Max := n;
    for i := 0 to n-1 do begin
      c := Slovo[i];
      if RusWord(c) then begin;
        c := StringReplace(c,'ё','е',[rfReplaceAll]);
        c := StringReplace(c,'Ё','Е',[rfReplaceAll]);
        if IsBB(c) or (Length(c) < 5) then begin
          if not HFind(zzz,c,ts,i0,' ') then zzz[i0] := c;
          continue;
        end;
        c := AnsiLowerCase(c);
        m := Length(c);
        j := 1;
        while j+4 <= m do begin
          b := Copy(c,j,5);
          if HFind(zzz,b,ts,i0,' ') then begin
            cod := WCod(zzz[i0]);
            if (j = 1) and (j < m-4) and (cod[1] <> '1') then cod[1] := '1';
            if (1 < j) and (j < m-4) and (cod[2] <> '1') then cod[2] := '1';
            if (1 < j) and (j = m-4) and (cod[3] <> '1') then cod[3] := '1';
            if (m = 5) and (cod[4] <> '1') then cod[4] := '1';
            zzz[i0] := b+' '+WCodToHex(cod);
          end else begin
            if (j = 1) and (j < m-4) then zzz[i0] := b+' 8'; {' 1000'}
            if (1 < j) and (j < m-4) then zzz[i0] := b+' 4'; {' 0100'}
            if (1 < j) and (j = m-4) then zzz[i0] := b+' 2'; {' 0010'}
            if m = 5 then zzz[i0] := b+' 1';                 {' 0001'}
          end;
          Inc(j);
        end;
      end;
      ProgressBarOE.Position := i;
    end;
  finally
    ProgressBarOE.Position := 0;
    OrfoBox.eW.ReadOnly := False;
    OrfoBox.eW.Text := '';
    OrfoBox.eW.SetFocus;
    Batch := False;
  end;
end;

procedure TOrfoBox.DelButtonClick(Sender: TObject);
var
  c, b, cod: string;
  j, m, n, i, i0: integer;
begin
  try
    if (not Batch) then if (Slovo.Count = 0) then Slovo.Add(OrfoBox.eW.Text)
                                             else Slovo[0] := OrfoBox.eW.Text;
    n := Slovo.Count;
    ProgressBarOE.Min := 0;
    ProgressBarOE.Max := n;
    for i := 0 to n-1 do begin
      c := Slovo[i];
      if RusWord(c) then begin;
        c := StringReplace(c,'ё','е',[rfReplaceAll]);
        c := StringReplace(c,'Ё','Е',[rfReplaceAll]);
        if IsBB(c) or (Length(c) < 5) then begin
          if HFind(zzz,c,ts,i0,' ') then zzz[i0] := '#';  {Только не '' или ' ' !!!}
          continue;
        end;
        m := Length(c);
        j := 1;
        while j+4 <= m do begin
          b := Copy(c,j,5);
          if HFind(zzz,b,ts,i0,' ') then begin
            cod := WCod(zzz[i0]);
            if (j = 1) and (j < m-4) and (cod[1] = '1') then cod[1] := '0';
            if (1 < j) and (j < m-4) and (cod[2] = '1') then cod[2] := '0';
            if (1 < j) and (j = m-4) and (cod[3] = '1') then cod[3] := '0';
            if (m = 5) and (cod[4] = '1') then cod[4] := '0';
            if cod <> '0000' then zzz[i0] := b+' '+WCodToHex(cod)
                             else zzz[i0] := '#';
          end;
          Inc(j);
        end;
      end;
      ProgressBarOE.Position := i;
    end;
  finally
    ProgressBarOE.Position := 0;
    OrfoBox.eW.ReadOnly := False;
    OrfoBox.eW.Text := '';
    OrfoBox.eW.SetFocus;
    Batch := False;
  end;
end;

procedure TOrfoBox.ExitButtonClick(Sender: TObject);
var
  i: integer;
begin
  Orfo.Clear;
  ProgressBarOE.Min := 0;
  ProgressBarOE.Max := ts;
  for i := 0 to ts-1 do if (zzz[i] <> '') and (zzz[i] <> '#' ) then begin
    Orfo.Add(zzz[i]);
    ProgressBarOE.Position := i;
  end;
  ProgressBarOE.Position := 0;
  Orfo.Sort;  {Для придания благородного вида :)}
  Orfo.SaveToFile(Form1.StartDir+'\~orfo~');
  //if zzz <> nil then FreeAndNil(zzz);   // не нужно, т.к. это же срабатывает при OnDeactivate
  //if Orfo <> nil then FreeAndNil(Orfo); //
  OrfoBox.Close;
end;

procedure TOrfoBox.ESCButtonClick(Sender: TObject);
begin
  if zzz <> nil then FreeAndNil(zzz);
  if Orfo <> nil then FreeAndNil(Orfo);
  if Slovo <> nil then FreeAndNil(Slovo);
  OrfoBox.Close;
end;

procedure TOrfoBox.LoadButtonClick(Sender: TObject);
begin
  if (OpenDialog1.Execute) then begin
    sName := OpenDialog1.FileName;
  end;
  if sName <> '' then begin
    Slovo.LoadFromFile(sName);
    OrfoBox.eW.Text := '<'+ExtractFileName(sName)+'>';
    OrfoBox.eW.ReadOnly := True;
    Batch := True;
  end;
end;


end.
