unit U_Dictmaint;
{Copyright 2000, Gary Darby, Intellitech Systems Inc., www.DelphiForFun.org

 This program may be used or modified for any non-commercial purpose
 so long as this original notice remains in place.
 All other rights are reserved
 }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, UDict, Grids, ExtCtrls, ComCtrls, Menus, Buttons;

Const
  Prechecked=true;
  Compressed=true;
type
  TDicMaintForm = class(TForm)
    Label1: TLabel;
    FindEdt: TEdit;
    WordGrid: TStringGrid;
    FindBtn: TButton;
    Panel1: TPanel;
    Label3: TLabel;
    Label5: TLabel;
    MinLenEdit: TEdit;
    MaxLenEdit: TEdit;
    UpDown1: TUpDown;
    UpDown2: TUpDown;
    Label2: TLabel;
    MainMenu1: TMainMenu;
    SaveDialog1: TSaveDialog;
    Dictionary1: TMenuItem;
    Load1: TMenuItem;
    Save1: TMenuItem;
    SaveAs1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    GroupBox1: TGroupBox;
    Shownormal: TCheckBox;
    Showabbrevs: TCheckBox;
    Showforeign: TCheckBox;
    Label4: TLabel;
    StatusBar1: TStatusBar;
    GroupBox2: TGroupBox;
    ReSortBtn: TButton;
    ScanBtn: TButton;
    ABtn: TSpeedButton;

    procedure FormActivate(Sender: TObject);
    procedure FindEdtKeyPress(Sender: TObject; var Key: Char);
    procedure ScanBtnClick(Sender: TObject);
    procedure FindBtnClick(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure WordGridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Load1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure checkboxclick(Sender: TObject);
    procedure WordGridDblClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ReSortBtnClick(Sender: TObject);
    procedure MinLenEditChange(Sender: TObject);
    procedure MaxLenEditChange(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure ABtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    AppPath:string;
    start,stop:char;
    min,max:integer;
    DicName:string;
    initialized:boolean;
    procedure AddWord(S: string);
    procedure RemoveWord(S: string);
    Procedure ReBuildList(s:string);
  end;

var
  DicMaintForm: TDicMaintForm;
  Dic:TDic;
  heapstat:THeapStatus;

implementation

uses U_AttribEdit;
{$R *.DFM}
Const
  endset=[' ',',','.','!','?',')',':',';','/','"','''',#10];
  startset=[' ','(','!','"','''',#10];


Procedure TDicMaintForm.RebuildList(s:string);
const
  x:array[0..3] of string =('','(A)','(F)','(A,F)');
var
  dicword:string;
  i,j:integer;
  a,f:boolean;

Begin
  If not dic.dicloaded then exit;
  with dic, WordGrid do
  Begin
    setrange(start,min,stop,max);
    Wordgrid.rowcount:=(letterindex[succ(start)]-letterindex[start]) div 10 +1;
    i:=-1;
    while getnextword(dicword,a,f) do
    Begin
      if (a and showabbrevs.checked) then j:=1 else j:=0;
      if (f and showforeign.checked) then inc(j,2);
      dicword:=dicword+x[j];
      If (shownormal.checked and (not a) and (not f))
         or (a and showabbrevs.checked)
         or (f and showforeign.checked)
      then
      Begin
        inc(i);
        Wordgrid.cells[i mod 10,i div 10]:=dicword;
        if s=dicword then
        begin
          col:=i mod 10;
          row:=i div 10;
        end;
      End;
    End;
    for j:= i+1 to (WordGrid.rowcount)*10 -1 do
          WordGrid.cells[j mod 10,j div 10]:='';
  End;
  WordGrid.setfocus {invalidate};
  if dic.dicloaded then
  with statusbar1, dic do
  begin
    panels[0].text:=dicname;
    panels[1].text:='Normal '+ inttostr(totalcount-abbrevcount-foreigncount);
    panels[2].text:='Abbrevs '+ inttostr(abbrevcount);
    panels[3].text:='Foreign '+inttostr(foreigncount);
    panels[4].text:='Total '+inttostr(totalcount);
  end;
End;

{************************ AddWord **************}
procedure TDicMaintForm.AddWord(S: string);
var
  a,f:boolean;
begin
  s:=lowercase(s);
  If not dic.lookup(s,a,f) then
  Begin
    start:=s[1]; stop:=s[1];
    a:=false;
    f:=false;
    if length(s)>max then max:=length(s);
    if (showabbrevs.checked or showforeign.checked ) then
    begin
      if (editworddlg.showmodal=MROK) then
      with editworddlg do
      begin
        a:=checkbox1.checked;
        f:=checkbox2.checked;
      end;
    end;
    If dic.addword(s,a,f) then Rebuildlist(s)
    else showmessage('Word '+s+ ' not added (too long?)');
  End
  else showmessage('Word ' + s +' already exists.');
end;

{****************** FindBtnClick ***************}
procedure TDicMaintForm.FindBtnClick(Sender: TObject);
var
  a,f:boolean;
  s:string;
begin
  s:=lowercase(FindEdt.text);
  if dic.IsValidword (s) then
    If dic.lookup(s,a,f) then
    Begin
      start:=s[1]; stop:=s[1];
      If min>length(s) then min:=length(s);
      If max<length(s) then max:=length(s);
      rebuildlist(s);
      with WordGrid do
      If (row<toprow) or (row>=toprow+visiblerowcount)
      then WordGrid.toprow:=WordGrid.row;
    End
    else showmessage(Findedt.text +' not found')
  else showmessage(FindEdt.text +'is not a valid word');
end;


{******************** FormActivate ****************}
procedure TDicMaintForm.FormActivate(Sender: TObject);
var
  btn:TSpeedButton;
  c:char;
begin
  Dic:=TDic.Create(prechecked);
  Apppath:=ExtractFilePath(Application.ExeName);
  for c:='b' to 'z' do
  with btn do
  begin
    btn:=TSpeedButton.create(self);
    parent:=abtn.parent;
    font:=abtn.font;
    left:=abtn.left+(ord(c)-ord('a'))*abtn.width;
    top:=abtn.top;
    width:=abtn.width;
    height:=abtn.height;
    groupindex:=abtn.groupindex;
    caption:=c;
    onclick:=abtnclick;
  end;
  load1click(sender);
  initialized:=true;
end;

{****************   FindEdtKeyPress *****************}
procedure TDicMaintForm.FindEdtKeyPress(Sender: TObject; var Key: Char);
{treat Enter as a click }
begin
  if key=#13 then
  Begin
   FindBtnclick(sender);
   key:=#00;
 End;
end;

function getword(var w:string):string;
    var
      i:integer;
    Begin
      i:=1;
      result:='';
      If length(w)=0 then exit;
      if w[length(w)]<>',' then w:=w+',';
      while (i<=length(w)) and  (w[i]in startset) do inc(i);
      If w[i]=' ' then getword:=''
      else
      Begin
        If i>1 then w:=copy(w,i,length(w)-i+1);
        i:=1;
        while (i<=length(w)) and  (not (w[i] in endset)) do inc(i);
        getword:=copy(w,1,i-1);
        system.delete(w,1,i);
      End;
    End;

{********************* ScanBrnClick ******************}
procedure TDicMaintForm.ScanBtnClick(Sender: TObject);
{Scan a text file for new words}

    function processline(line:string):boolean;
    {process a line during scanline}
    {return true if user says quit}
     var
      quit:boolean;
      dicword:string;
      r:word;
      a,fo:boolean;
      begin
        quit:=false;
        repeat
          dicword:=getword(line);
          if (dicword[1] in ['a'..'z']) then
          if (dic.IsValidword(dicword)) and (length(dicword)>0)
              and (not dic.lookup(dicword,a,fo)) then
          Begin
            r:= messagedlg('Add '+dicword,
                          mtconfirmation, mbyesnocancel,0);
            if r = mryes then
            Begin
              if editworddlg.showmodal=MROK then
              Begin
                with editworddlg do dic.addword(dicword,checkbox1.checked,checkbox2.checked);
                start:=dicword[1]; stop:=dicword[1];
                If min>length(dicword) then min:=length(dicword);
                If max<length(dicword) then max:=length(dicword);
                rebuildlist(dicword);
                dic.setrange('a',1,'z',dic.maxwordlength);
              End;
            End
            else if r=mrcancel then quit := true;
          end;
        until (length(line)=0) or (quit);
        result:=quit;
      End;


var
  f:textfile;
  quit:boolean;
  savemin,savemax:integer;
  savestart,savestop:char;
  saveword:string;
  line:string;
begin
  with Dicform.opendialog1 do
  begin
    if execute and fileexists(filename) then
    Begin
      assignfile(f,filename);
      reset(f);
      quit:=false;
      savemin:=min;
      savemax:=max;
      savestart:=start;
      savestop:=stop;
      with wordgrid do saveword:=cells[col,row];
      dic.setrange('a',1,'z',dic.maxwordlength);
      readln(f,line);
      closefile(f);
      if length(line)<255 then {normal file}
      begin
        reset(f);
        while (not eof(f)) and (not quit) do
        Begin
          readln(f,line);
          line:=lowercase(line);
          quit:=processline(line);
        end;
        closefile(f);
      end
      else {long lines - use blockread}
      showmessage('Lines too long -'+
                  #13+'Reformat file so lines are less than 25 characters');
      {restore range settings}
      start:=savestart;
      stop:=savestop;
      min:=savemin;
      max:=savemax;
      dic.setrange(start,min,stop,max);
      rebuildlist(saveword);
    end;

  end;
end;

{****************** WordGrid1DblClick **************}
procedure TDicMaintForm.WordGridDblClick(Sender: TObject);
var
  w,rest:string;
  rowsave:integer;
  p:integer;
begin
  with WordGrid do
  Begin
    w:=cells[col,row];
    If w[length(w)]=')' then
    begin
      p:=pos('(',w);
      if p>0 then
      Begin
        rest:=copy(w,p,length(w)-p);
        w:=copy(w,1,p-1);
      End
      else showmessage('Error in word - no ''(''');
    end;
    with editworddlg do
    Begin
      label1.caption:=w;
      if showmodal=mrOK then
      Begin
        dic.removeword(w);
        dic.addword(w,checkbox1.checked,checkbox2.checked);
      End;
    End;
    rowsave:=row
  end;
  rebuildlist(w);
  WordGrid.toprow:=rowsave;
end;

{************************ RemoveWord ****************}
procedure TDicMaintForm.RemoveWord(S:string);
var
  a,f:boolean;
  n:integer;
  saverow,savecol:integer;
begin
  with dic do
  Begin
    n:= pos('(',s);
    if n>0 then s:=copy(s,1,n-1);
    s:=lowercase(s);
    If lookup(s,a,f) then
      if messagedlg('Remove '+s+'?',mtconfirmation, [mbyes,mbno],0)=mryes
      then
      with WordGrid do
      Begin
        saverow:=row;
        savecol:=col;
        dic.removeword(s);
        rebuildlist('');
        col:=savecol;
        row:=saverow;
      End;
  End;
end;

{********************* FormClose *******************}
procedure TDicMaintForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
   if dic.dicdirty then dic.checksave;
end;

 {******************* WordGridKeyDown ********************}
procedure TDicMaintForm.WordGridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  s:string;
  begin
    If key=vk_delete then
    begin
      with WordGrid do removeword(cells[col,row]);
    end
    else If key=vk_insert then
    with WordGrid do
    begin
      s:=lowercase(inputbox('Add a word','Enter a new word and press enter',''));
      if length(s)>0 then
      begin
        addword(s);
      end;
    end;
  end;

{**************** Load1Click ******************}
procedure TDicMaintForm.Load1Click(Sender: TObject);
begin
  with dicform.opendialog1 do
  begin
    if execute then
    begin
      cursor:=crHourGlass;
      refresh;
      Dic.loadDicfromfile(filename);
      dicname:=filename;
      start:='a'; stop:='a';
      min:=1; max:=31;
      abtn.down:=true;
      abtnclick(abtn);
      cursor:=crDefault;
    end;
  end;
end;

{********************** Save1Click ******************}
procedure TDicMaintForm.Save1Click(Sender: TObject);
{If extension is txtthe save umcompressed file
 otherwise save compressed format}
begin
  if lowercase(extractfileExt(dicname))='.txt'
  then Dic.SaveDicToTextFile(dicname)
  else Dic.SaveDicToFile(dicname);
end;

{***************** CheckBoxClick ****************}
procedure TDicMaintForm.checkboxclick(Sender: TObject);
{User changed a display option radio button}
begin
   with WordGrid do rebuildlist(cells[row,col]);
end;

{******************** FormCloseQuery ***************}
procedure TDicMaintForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
  mr:integer;
begin
  canclose:=true;
  if dic.dicdirty then
  begin
    mr:=dic.checksave;
    if mr=mrcancel then canclose:=false;
  end;
end;

{**************** ReSortBtnClick *******************}
procedure TDicMaintForm.ReSortBtnClick(Sender: TObject);
var
  saveword:string;
begin
  with WordGrid do
  begin
    saveword:=cells[col,row];
    dic.resortrange;
    rebuildlist(saveword);
  end;
end;

{********************* MinLenEditChnage ******************}
procedure TDicMaintForm.MinLenEditChange(Sender: TObject);
begin
  if not initialized then exit;
  min:=strtointdef(minlenedit.text,1);
  {if initialized then} {exit is called during creation - before we're ready}
  with WordGrid do
  rebuildlist(cells[col,row]);

end;

{*************************  MaxLenEditChnage ***************}
procedure TDicMaintForm.MaxLenEditChange(Sender: TObject);
begin
  if not initialized then exit;
  max:=strtointdef(maxlenedit.text,dic.maxwordlength);
  with WordGrid do
  rebuildlist(cells[col,row]);
end;

procedure TDicMaintForm.SaveAs1Click(Sender: TObject);
begin
  with savedialog1 do
  begin
    initialdir:=extractfilepath(dicname);
    filename:=extractfilename(dicname);
    if execute then
    begin
      if lowercase(extractfileExt(filename))='.txt'
      then Dic.SaveDicToTextFile(filename)
      else Dic.SaveDicToFile(filename);
    end;
  end;
end;


procedure TDicMaintForm.ABtnClick(Sender: TObject);
begin
  start:=  TSpeedButton(sender).caption[1];
  stop:=start;
  rebuildlist('');

end;

end.