udict.pas

Delphi for fun library v12, latest. This is the library for manuplating list, combination-permutati

unit UDict;
{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
 }

{A dictionary class  -

 Leading characters of each word that match preceding words are replaced by a
 byte containing the count of characters that match, leading byte also has flags
 indicating abbrevations and foreign words.

 A letterindex pointing to start of each letter in word list is maintained.
 }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
   Controls, Forms, Dialogs;

const
    dichighletter='z';
type

  TDicForm = class(TForm)
    OpenDialog1: TOpenDialog;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

 TDic=class

    {Initial character of each word is formatted as:
      Bit
       0 - unused - must be 1 in file indicating that this is a compressed dictionary
       1 - word is foreign
       2 - word is abbreviation
       3 - word is captialized (proper noun)
       4-7 count of letters matching previous word in list
    }
    protected
    Words:TStringList;
    ExpandedList:TStringList;  {Used for Getwordbynumber}

    {range fields - set by setrange method}
    startletter,endletter:char;
    startlength,endlength:byte;
    {used by saverange and restorerange methods}
    savestartletter,saveendletter:char;
    savestartlength,saveendlength:byte;

    {current status fields}
    currletter:char;
    currlength:byte;
    currentWordIndex:integer;
    Currword, prevword:string;

        Letterindex:array ['a'..succ(dichighletter)] of integer;
        AbbrevCount,ForeignCount,CapsCount,TotalCount:integer;
        DicDirty:boolean;

    {prechecked ==> no need to check for validword in Lookup or AddWord}
    Prechecked:boolean;
    IndexDirty:boolean;

    public

    IniPathName:string;  {path to dic.inifile}
    Maxwordlength:integer;
    DicLoaded:boolean;
    Dicname:string;
    DefaultDic,SmallDic,MediumDic,LargeDic:String;

    constructor Create(Precheckedflag:boolean); overload;
    constructor Create(Newpath:string; Precheckedflag:boolean); overload;

    procedure LoadDicFromFile(filename:string);
    procedure LoadDefaultDic;
    procedure LoadSmallDic;
    procedure LoadMediumDic;
    procedure LoadLargeDic;

    procedure SaveDicToFile(filename:string);
    procedure SaveDicToTextFile(filename:string); {save uncompressed}

    procedure Setrange(const letter1:char;length1:byte;const letter2:char;length2:byte);
    procedure saverange;
    procedure restorerange;

    function Lookup(s:string; var abbrev,foreign,caps:boolean):boolean;
    function GetnextWord(var word:string;var abbrev,foreign,caps:boolean):boolean; overload;
    Function GetnextWord(var word:string;var wordnbr:integer; var abbrev,foreign,caps:boolean):boolean; overload;
    function GetWordByNumber(n:integer; var word:string):boolean;
    function IsValidword(var s:string):boolean;
    function AddWord(s:String;abbrev,foreign,caps:boolean):boolean;
    function RemoveWord(s:String):boolean;
    procedure Rebuildindex; {after insertions or deletions}
    procedure reSortrange;   {fixup missorted dictionary}
    function  GetwordCount:integer;
    function checksave:integer;
    function getDicSize:integer;

    {procedure Findwords(scrambled:string; NbrToFind:byte; List:Tstrings);}
  End;


var
  DicForm: TDicForm;
  PubDic:TDic;
  PrivDic:TDic;

implementation

{$R *.DFM}

Uses Inifiles;

 procedure createdicform;
 begin
   dicform:=tdicform.create(application.mainform);
 end;

 {**************** Local functions ********************}
 Function min(a,b:integer):integer; Begin If a<b then result:=a else result:=b; End;

  Function CompressWord(prev,word:String; abbrev,foreign,caps:boolean):String;
   {replace initial letters of word that match prev word with a count
    field}
       var
         len,prevlen,i,letterstocopy:integer;
         mask:byte;
       Begin
         len:=length(word);
         prevlen:=length(prev);
         i:=1;
         while (i<=min(len,prevlen)) and (word[i]=prev[i]) and (i<16) do inc(i);
         letterstocopy:=i-1;
         result:=' '+copy(word,i,len-i+1);
         mask:=$80;
         If abbrev then mask:=mask or $40;
         If foreign then mask:=mask or $20;
         If caps then mask:=mask or $10;
         result[1]:=char(letterstocopy or mask);
       End;

    Function ExpandWord(prev,Compressedword:string;Var abbrev,foreign,caps:boolean):String;
    {expand a compressed word  to full length}
    Begin
      result:=copy(prev,1,ord(Compressedword[1]) and $0F)
            + copy(compressedword,2,length(compressedword)-1);
      if (byte(compressedword[1]) and $40)>0 then abbrev:=true else abbrev:=false;
      if (byte(compressedword[1]) and $20)>0 then foreign:=true else foreign:=false;
      if (byte(compressedword[1]) and $10)>0 then caps:=true else caps:=false;
    End;

 {*************** TDic.Create ********************}
 Constructor TDic.Create(precheckedflag:boolean);
  {create dictionary object}
 var
   i:char;
   //path:string;
   ini:TInifile;
 Begin
  inherited create;
  IniPathName:=extractfilepath(application.exename);
  prechecked:=precheckedflag;
  words:=TStringlist.create;
  ExpandedList:=TstringList.create;
  words.sorted:=false;
  words.duplicates:=dupIgnore;
  For i:='a' to high(letterindex){dichighletter}{'z'} do letterindex[i]:=0;
  CurrentWordIndex:=-1;
  IndexDirty:=true;
  DicDirty:=false;
  MaxWordLength:=0;
  Dicloaded:=false;
  {fill in dictionary names that exist}
  //path:=extractfilepath(application.exename);
  ini:=TIniFile.create(IniPathname+'Dic.ini');
  SmallDic:=ini.ReadString('Files','Small Dictionary',InipathName + 'Small.Dic');
  if not fileexists(smalldic) then smalldic:='';
  MediumDic:=ini.ReadString('Files','Medium Dictionary',InipathName + 'General.Dic');
  if not fileexists(Mediumdic) then Mediumdic:='';
  LargeDic:=ini.ReadString('Files','Large Dictionary',IniPathName + 'Full.Dic');
  if not fileexists(Largedic) then Largedic:='';
  ini.free;
 End;

 {*************** TDic.Create ********************}
 Constructor TDic.Create(newpath:string; precheckedflag:boolean); 
 {create dictionary object}
 var
   i:char;
   //path:string;
   ini:TInifile;
 Begin
  inherited create;
  IniPathName:=newpath;
  prechecked:=precheckedflag;
  words:=TStringlist.create;
  ExpandedList:=TstringList.create;
  words.sorted:=false;
  words.duplicates:=dupIgnore;
  For i:='a' to high(letterindex){dichighletter}{'z'} do letterindex[i]:=0;
  CurrentWordIndex:=-1;
  IndexDirty:=true;
  DicDirty:=false;
  MaxWordLength:=0;
  Dicloaded:=false;
  {fill in dictionary names that exist}
  //path:=extractfilepath(application.exename);
  ini:=TIniFile.create(IniPathName+'Dic.ini');
  SmallDic:=ini.ReadString('Files','Small Dictionary',IniPathName+ 'Small.Dic');
  if not fileexists(smalldic) then smalldic:='';
  MediumDic:=ini.ReadString('Files','Medium Dictionary', IniPathName+ 'General.Dic');
  if not fileexists(Mediumdic) then Mediumdic:='';
  LargeDic:=ini.ReadString('Files','Large Dictionary',IniPathName + 'Full.Dic');
  if not fileexists(Largedic) then Largedic:='';
  ini.free;
 End;


 {******************* TDic.LoadDicFromFile *************}
 Procedure TDic.LoadDicFromFile(filename:string);
 {load a dictionary}

 function getword(var w:string):string; overload;
    var
      i:integer;
    Begin
      i:=1;
      result:='';
      If length(w)=0 then exit;
      if w[length(w)]<>',' then w:=w+','; {make sure we have a stopper}
      {get to first letter}
      while (i<=length(w)) and  (not (w[i] in ['a'..dichighletter{'z'}])) do inc(i);
      if w[i] in ['a'..dichighletter{'z'}] then
      begin
        If i>1 then w:=copy(w,i,length(w)-i+1);
        i:=1;
        while (i<=length(w)) and  ((w[i] in ['a'..dichighletter{'z'}])) do inc(i);
        result:=copy(w,1,i-1);
        system.delete(w,1,i);
      End
      else w:='';
    End;

 function getword(const ww:string; var startat:integer):string; overload;
    var
      i:integer;
      w:string;
    Begin
      w:=ww;
      result:='';
      If length(w)=0 then exit;
      if startat=0 then exit;
      i:=startat;
      if w[length(w)]<>',' then w:=w+','; {make sure we have a stopper}
      {get to first letter}
      while (i<=length(w)) and  (not (w[i] in ['a'..dichighletter{'z'}])) do inc(i);
      startat:=i;
      if w[i] in ['a'..dichighletter{'z'}] then
      begin
        while (i<=length(w)) and  ((w[i] in ['a'..dichighletter{'z'}])) do inc(i);
        result:=copy(w,startat,i-startat);
        startat:=i+1;
      End
      else
      begin
        w:='';
        startat:=0;
      end;  
      
    End;

 var
   line,prevword,dicword,w:string;
   f:textfile;
   compressed:boolean;
   mr,i:integer;
   templist:TStringlist;
   startat:integer;
 Begin
   mr:=mrYes;
   If dicloaded and dicdirty then mr:=checksave;
   if not (mr=mrcancel) then
   begin
     if words.count>0 then words.clear;
     if length(filename)=0 then
     Begin
       if dicform=nil then createdicform; 
       dicform.opendialog1.execute;
       filename:=dicform.opendialog1.filename;
     End;
     If fileexists(filename) then
     Begin
       assignfile(f,filename);
       reset(f);
       readln(f,line);
       {high order bit of 1st char ==> dictionary is compressed}
       if (ord(line[1])and $80)>0 then compressed:=true
           else compressed:=false;
       closefile(f);
       screen.cursor:=crHourglass;
       If not compressed then
       Begin
         {load a text file and make a dictionary }
         reset(f);
         {first read the file assuming that it is a normal text file -
          put words into a wordlist, sort it, eliminating duplicates,
          then make dic from templist words}
          templist:=TstringList.create;
          while not eof(f) do
          begin
            readln(f,line);
            line:=lowercase(line);
            startat:=1;
            while (startat>0) and (startat<length(line)) {length(line)>0} do
            begin
              w:=getword(line,startat);
              if length(w)>0 then templist.add(w);
            end;
          end;
          closefile(f);
          templist.duplicates:=dupignore;
          templist.sort;
          prevword:='';
          for i:= 0 to templist.count-1 do
          Begin
           line:=templist[i];
           dicword:=CompressWord(prevword,line,false,false,false);
           If length(dicword)>1 then words.add(dicword);
           prevword:=line;
         End;
         templist.free;
       End
       else Words.loadfromfile(filename); {load normal compreesed dictionary}
      { for i:=7247 downto 5872 do words.delete(i); fixup broken dictionary}
       RebuildIndex;
       dicloaded:=true;
       dicdirty:=false;
       Dicname:=filename;
       screen.cursor:=crDefault;
     End
     else showmessage('Dictionary file '+filename+' not found');
   end;
 end;

 {**************** TDic.LoadDefaultDic ***********************}
  Procedure TDic.LoadDefaultDic;
 {Load a default dictionary}
 Var
   ini:TIniFile;
   //path:string;
 Begin
   //path:=extractfilepath(application.exename);
   ini:=TIniFile.create(IniPathName+'Dic.ini');
   DefaultDic:=ini.ReadString('Files','Default Dictionary',IniPathName + 'Full.Dic');
   If not fileexists(DefaultDic) then
   begin
     if dicform=nil then createdicform;
     with dicForm.opendialog1 do
     Begin
       initialdir:=Inipathname;
       If execute then
       Begin
          DefaultDic:=Dicform.Opendialog1.filename;
          Ini.WriteString('Files','Default Dictionary',DefaultDic);
       End;
     End;
   end;
   LoadDicFromFile(DefaultDic);
   ini.free;
 End;

 {**************** TDic.LoadSmallDic ***********************}
  Procedure TDic.LoadSmallDic;
 {Load a small dictionary}
 Var
   ini:TIniFile;
   //path:string;
 Begin
   //path:=extractfilepath(application.exename);
   ini:=TIniFile.create(IniPathName+'Dic.ini');
   SmallDic:=ini.ReadString('Files','Small Dictionary',IniPathName + 'Small.Dic');
   If not fileexists(SmallDic) then
   begin
     if dicform=nil then createdicform;
     with dicForm.opendialog1 do
     Begin
       title:='Select Small dictionary';
       initialdir:=extractfilepath(application.exename);
       If execute then
       Begin
         SmallDic:=Dicform.Opendialog1.filename;
         Ini.WriteString('Files','Small Dictionary',SmallDic);
       End;
     End;
   end;
   LoadDicFromFile(SmallDic);
   ini.free;
 End;

  {**************** TDic.LoadMediumDic ***********************}
  Procedure TDic.LoadMediumDic;
 {Load a Medium dictionary}
 Var
   ini:TIniFile;
   //path:string;
 Begin
   //path:=extractfilepath(application.exename);
   ini:=TIniFile.create(IniPathName+'Dic.ini');
   MediumDic:=ini.ReadString('Files','Medium Dictionary',IniPathname + 'General.Dic');
   If not fileexists(MediumDic) then
   begin
     if dicform=nil then createdicform;
     with dicForm.opendialog1 do
     Begin
       title:='Select Medium dictionary';
       initialdir:=extractfilepath(application.exename);
       If execute then
       Begin
          MediumDic:=Dicform.Opendialog1.filename;
          Ini.WriteString('Files','Medium Dictionary',MediumDic);
       End;
     End;
   end;
   LoadDicFromFile(MediumDic);
   ini.free;
 End;

  {**************** TDic.LoadLargeDic ***********************}
  Procedure TDic.LoadLargeDic;
 {Load a large dictionary}
 Var
   ini:TIniFile;
   //path:string;
 Begin
   //path:=extractfilepath(application.exename);
   ini:=TIniFile.create(IniPathname+'Dic.ini');
   LargeDic:=ini.ReadString('Files','Large Dictionary',IniPathname + 'Full.Dic');
   If not fileexists(LargeDic) then
   begin
     if dicform=nil then createdicform;
     with dicForm.opendialog1 do
     Begin
       title:='Select Large dictionary';
       initialdir:=extractfilepath(application.exename);
       If execute then
       Begin
          LargeDic:=Dicform.Opendialog1.filename;
          Ini.WriteString('Files','Large Dictionary',LargeDic);
       End;
     End;
   end;