unit bible;

// {$LONGSTRINGS ON}

interface

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

const
  RusToEngTable: array[1..27] of integer =
    (1,2,3,4,5,20,21,22,23,24,25,26,6,7,8,9,10,11,12,13,14,15,16,17,18,19,27);
  EngToRusTable: array[1..27] of integer =
    (1,2,3,4,5,13,14,15,16,17,18,19,20,21,22,23,24,25,26,6,7,8,9,10,11,12,27);

const
  MAX_BOOKQTY = 256;

  // search params bits
  spWordParts = $01;
  spContainAll = $02;
  spFreeOrder = $04;
  spAnyCase = $08;

type
  TBibleSet = set of 0..255;

type
  TBibleSearchEvent =
    procedure(Sender: TObject; NumVersesFound, book,chapter,verse: integer; s: string) of object;

type
  TBible = class(TComponent)
  private
    { Private declarations }
    FIniFile: string;
    FPath: string; // FPath := ExtractFilePath(FIniFile);
    FShortPath: string; // FPath = d:\biblequote\russian -> ShortPath = russian
    FName: string; // full description (title) of the module
    FShortName: string; // short abbreviation, like NIV, KJV
    FBible: boolean; // is this a Bible translation?
    FHasOT: boolean; // does it have Old Testament?
    FHasNT: boolean; // ... New Testament
    FHasAP: boolean; // ... Apocrypha books
    FBookQty: integer; // quantity of books in module (default = 66)
    FChapterSign: string; // the beginning of a chapter
    FVerseSign: string; // the beginning of a verse
    FFontName: string;
    FFontCharset: integer;

    FAlphabet: string; // ALL letters that can be parts of text in the module

    FSoundDir: string;

    FHTML: string; // allowed HTML codes
    FFiltered: boolean;
    FDefaultFilter: boolean; // using default filter

    FLines: TStrings; // these are verses when you open a chapter

    BookLines: TStrings; // just a buffer

    FBook, FChapter, FVerseQty: integer;
    FRememberPlace: boolean;

    FLasTBible, FLastChapter, FLastVerse: integer;

    FVersesFound: integer; // run-time counter of words found during search
    FOnVerseFound: TBibleSearchEvent;
    FOnSearchComplete: TNotifyEvent;
    FStopSearching: boolean;

    FOnChangeModule: TNotifyEvent;
  protected
    { Protected declarations }
    procedure LoadIniFile(value: string);

    function SearchOK(source: string; words: TStrings; params: byte): boolean;
    procedure SearchBook(words: TStrings; params: byte; book: integer);

    procedure SetHTMLFilter(value: string);
  public
    { Public declarations }
    ChapterQtys: array[1..MAX_BOOKQTY] of integer;
    FullNames: array[1..MAX_BOOKQTY] of string;
    VarShortNames: array[1..MAX_BOOKQTY] of string; // âàðèàíòû ñîêðàùåíèÿ íàçâàíèÿ êíèãè
    ShortNames: array[1..MAX_BOOKQTY] of string; // ñòàíäàðòíîå ñîêðàùåíèå
    PathNames: array[1..MAX_BOOKQTY] of string;

    property IniFile: string read FIniFile write LoadIniFile;
    property Path: string read FPath;
    property ShortPath: string read FShortPath;
    property Name: string read FName;
    property ShortName: string read FShortName;
    property isBible: boolean read FBible;
    property HasOldTestament: boolean read FHasOT;
    property HasNewTestament: boolean read FHasNT;
    property HasApocrypha: boolean read FHasAP;
    property BookQty: integer read FBookQty;
    property ChapterSign: string read FChapterSign;
    property VerseSign: string read FVerseSign;

    property Alphabet: string read FAlphabet;
    property FontCharset: integer read FFontCharset;
    property FontName: string read FFontName;

    property CurBook: integer read FBook;
    property CurChapter: integer read FChapter;
    property VerseQty: integer read FVerseQty write FVerseQty;

    property RememberPlace: boolean read FRememberPlace write FRememberPlace;

    property Lines: TStrings read FLines;

    property SoundDirectory: string read FSoundDir;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure OpenChapter(book, chapter: integer);

    function OpenAddress(s: string; var book, chapter,
      fromverse, toverse: integer): boolean;

    procedure Search(s: string; params: byte; bookset: TBibleSet);
    procedure StopSearching;

    procedure ClearBuffers;

    function AddressToInternal(book,chapter,verse: integer;
      var ibook,ichapter,iverse: integer): boolean;
    function InternalToAddress(ibook,ichapter,iverse: integer;
      var book,chapter,verse: integer): boolean;

    function ShortPassageSignature(book,chapter,fromverse,toverse: integer): string;
    function FullPassageSignature(book,chapter,fromverse,toverse: integer): string;

    function CountVerses(book,chapter: integer): integer;
  published
    { Published declarations }
    property Filtered: boolean read FFiltered write FFiltered;
    property HTMLFilter: string read FHTML write SetHTMLFilter;
    property VersesFound: integer read FVersesFound;

    property OnVerseFound: TBibleSearchEvent read FOnVerseFound write FOnVerseFound;
    property OnSearchComplete: TNotifyEvent read FOnSearchComplete write FOnSearchComplete;
    property OnChangeModule: TNotifyEvent read FOnChangeModule write FOnChangeModule;
  end;

procedure Register;

implementation

var
  AlphabetArray: array[0..255] of char;

procedure Register;
begin
  RegisterComponents('Samples', [TBible]);
end;

constructor TBible.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBookQty := 0;
  FBook := 1;
  FChapter := 1;

  FFiltered := true;
  FHTML := DefaultHTMLFilter;
  FDefaultFilter := true;

  FAlphabet :=
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' +
    'ÀÁÂÃÄÅ¨ÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäå¸æçèéêëìíîïðñòóôõö÷øùúûüýþÿ';

  FFontName := '';
  FFontCharset := -1;

  FStopSearching := false;

  FLasTBible := 0;
  FLastChapter := 0;
  FLastVerse := 0;

  FRememberPlace := true;

  FLines := TStringList.Create;
  BookLines := TStringList.Create;
end;

destructor TBible.Destroy;
begin
  BookLines.Free;
  FLines.Free;
  inherited Destroy;
end;

procedure TBible.SetHTMLFilter(value: string);
begin
  FHTML := DefaultHTMLFilter + value;
  FDefaultFilter := false;
end;

procedure TBible.LoadIniFile(value: string);
var
  s: TStrings;
  i, cur: integer;
begin
  try
    s := TStringList.Create;
    s.LoadFromFile(value);
  except
    raise Exception.CreateFmt('TBible.LoadIniFile: Error loading file %s', [value]);
    s.Free;
    Exit;
  end;

  FBookQty := 0;

  FSoundDir := '';

  FHTML := DefaultHTMLFilter;
  FDefaultFilter := true;

  for i:=1 to MAX_BOOKQTY do ChapterQtys[i] := 0; // clear

  cur := -1;
  i := 0;

  repeat
    Inc(cur);
    if cur = s.Count then break;

    if IniStringSecondPart(s[cur]) = '' then continue;

    if IniStringFirstPart(s[cur]) = 'BibleName' then
    begin
      FName := IniStringSecondPart(s[cur]);
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'BibleShortName' then
    begin
      FShortName := IniStringSecondPart(s[cur]);
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'Bible' then
    begin
      FBible := LowerCase(IniStringSecondPart(s[cur])) = 'y';
      continue;
    end;
{
    if IniStringFirstPart(s[cur]) = 'ShowVerseNumbers' then
    begin
      ShowVerseNumbers := LowerCase(IniStringSecondPart(s[cur])) = 'y';
      continue;
    end;
}
    if IniStringFirstPart(s[cur]) = 'OldTestament' then
    begin
      FHasOT := LowerCase(IniStringSecondPart(s[cur])) = 'y';
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'NewTestament' then
    begin
      FHasNT := LowerCase(IniStringSecondPart(s[cur])) = 'y';
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'Apocrypha' then
    begin
      FHasAP := LowerCase(IniStringSecondPart(s[cur])) = 'y';
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'HTMLFilter' then
    begin
      HTMLFilter := IniStringSecondPart(s[cur]);
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'Alphabet' then
    begin
      FAlphabet := IniStringSecondPart(s[cur]);
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'DesiredFontName' then
    begin
      FFontName := IniStringSecondPart(s[cur]);
      continue;
    end;
{
    if IniStringFirstPart(s[cur]) = 'DesiredFontPath' then
    begin
      DesiredFontPath := IniStringSecondPart(s[cur]);
      continue;
    end;
}
    if IniStringFirstPart(s[cur]) = 'DesiredFontCharset' then
    begin
      FFontCharset := StrToInt(IniStringSecondPart(s[cur]));
      continue;
    end;
{
    if IniStringFirstPart(s[cur]) = 'ParagraphSkips' then
    begin
      ParaSkip := StrToInt(IniStringSecondPart(s[cur]));
      continue;
    end;
}
    if IniStringFirstPart(s[cur]) = 'ChapterSign' then
    begin
      FChapterSign := IniStringSecondPart(s[cur]);
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'VerseSign' then
    begin
      FVerseSign := IniStringSecondPart(s[cur]);
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'BookQty' then
    begin
      FBookQty := StrToInt(IniStringSecondPart(s[cur]));
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'SoundDirectory' then
    begin
      FSoundDir := IniStringSecondPart(s[cur]);
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'PathName' then
    begin
      Inc(i);
      PathNames[i] := IniStringSecondPart(s[cur]);
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'FullName' then
    begin
      FullNames[i] := IniStringSecondPart(s[cur]);
      continue;
    end;

    if IniStringFirstPart(s[cur]) = 'ShortName' then
    begin
      VarShortNames[i] := IniStringSecondPart(s[cur]);
      continue;
    end;

    ShortNames[i] := FirstWord(VarShortNames[i]);

    if IniStringFirstPart(s[cur]) = 'ChapterQty' then
    begin
      ChapterQtys[i] := StrToInt(IniStringSecondPart(s[cur]));
      continue;
    end;

  until false;

  FIniFile := value;
  FPath := ExtractFilePath(value);
  FShortPath := AnsiLowerCase(ExtractFileName(Copy(FPath,1,Length(FPath)-1)));

  FLasTBible := 0;
  FLastChapter := 0;
  FLastVerse := 0;

  for i:=0 to 255 do AlphabetArray[i] := ' ';

  for i:=1 to Length(FAlphabet) do
    AlphabetArray[Ord(FAlphabet[i])] := FAlphabet[i];

  s.Free;

  if Assigned(FOnChangeModule) then FOnChangeModule(Self);
end;

procedure TBible.OpenChapter(book, chapter: integer);
var
  j, k, ichapter: integer;
  foundchapter: boolean;
begin
  FLines.Clear;

  BookLines.LoadFromFile(FPath + PathNames[book]);

  ichapter := 0;

  j := -1;

  repeat
    Inc(j);
    if Pos(FChapterSign, BookLines[j]) > 0 then Inc(ichapter);
  until (j = BookLines.Count-1) or (ichapter = chapter);

  foundchapter := (ichapter = chapter);

  if ichapter = chapter then
  begin
    if foundchapter
    then k := j+1
    else k := j;

    for j:=k to BookLines.Count-1 do
    begin
      if Pos(FChapterSign, BookLines[j]) > 0 then break;

      if Pos(FVerseSign, BookLines[j]) > 0 then
      begin
        //Inc(iverse);
        FLines.Add(BookLines[j]); // add newly found verse of this chapter
      end else if FLines.Count > 0 then
        FLines[FLines.Count-1] := FLines[FLines.Count-1] + ' ' + BookLines[j];
        // add to current verse (paragraph)
    end;

    FBook := book;
    FChapter := chapter;
  end;

  if FFiltered and (FLines.Count <> 0) then
    FLines.Text := ParseHTML(FLines.Text, FHTML);

  FVerseQty := FLines.Count;

  if FLines.Count = 0 then
  raise Exception.CreateFmt('TBible.OpenChapter: Passage not found.'
    + #13#10
    + #13#10 + 'IniFile = %s'
    + #13#10 + 'Book=%d Chapter=%d', [FIniFile, book,chapter]);
end;

function TBible.SearchOK(source: string; words: TStrings; params: byte): boolean;
var
  i, lastpos, curpos: integer;
  res: boolean;
  src, wrd: string;
begin
  res := true;

  src := source;

  if (params and spWordParts <> spWordParts) then
  begin
    for i:=1 to Length(src) do src[i] := AlphabetArray[Ord(src[i])];

    src := ' ' + src + ' ';
  end;

  if (params and spAnyCase = spAnyCase) then src := AnsiLowerCase(src);

  if not (params and spContainAll = spContainAll) then
  begin
    res := false;

    for i := 0 to words.Count-1 do
    begin
      wrd := words[i];
      if (params and spAnyCase = spAnyCase) then wrd := AnsiLowerCase(wrd);

      res := res or (Pos(wrd,src) > 0);
      if res then break;
    end;

    Result := res;
    Exit;
  end;

  i := 0;
  lastpos := 0;

  repeat
    wrd := words[i];
    if (params and spAnyCase = spAnyCase) then wrd := AnsiLowerCase(wrd);

    curpos := Pos(wrd,src);

    res := res and (curpos > 0);
    if not res then break;

    if not (params and spFreeOrder = spFreeOrder) then
    begin
      if curpos < lastpos then
      begin
        res := false;
        break;
      end
      else lastpos := curpos;
    end;

    Inc(i);
  until (not res) or (i = words.Count);

  Result := res;
end;

procedure TBible.SearchBook(words: TStrings; params: byte; book: integer);
var
  i, chapter, verse: integer;
  btmp: TStrings; // lines buffer from the book
  s: string;
begin
  chapter := 0;
  verse := 0;

  BookLines.Clear;
  BookLines.LoadFromFile(FPath + PathNames[book]);

  // reformat BookLines to complete VERSES, because verses can go in several lines

  btmp := TStringList.Create;

  s := '';

  for i := 0 to BookLines.Count-1 do
  begin
    if (Pos(FChapterSign, BookLines[i]) > 0) or (Pos(FVerseSign, BookLines[i]) > 0) then
    begin
      btmp.Add(s);
      s := BookLines[i];
    end
    else s := s + ' ' + BookLines[i]; // concatenate paragraphs
  end;

  BookLines.Clear;
  BookLines.AddStrings(btmp);

  // reformat finished

  for i:=0 to BookLines.Count-1 do
  begin
    if FStopSearching then break;

    if Pos(FChapterSign, BookLines[i]) <> 0 then
    begin
      Inc(chapter);
      verse := 0;
      continue;
    end;

    if Pos(FVerseSign, BookLines[i]) <> 0 then
    begin
      Inc(verse);
      if SearchOK(BookLines[i], words, params) and (chapter > 0) then
      begin
        //FLines.Add(Format('%d %d %d $$$%s', [book,chapter,verse,BookLines[i]]));
        //FLines.Add(Format('%d %d %d', [book,chapter,verse]));
        Inc(FVersesFound);

        if Assigned(FOnVerseFound) then
        FOnVerseFound(Self, FVersesFound, book, chapter, verse, BookLines[i]);
      end;
    end;
  end;

  //if FFiltered then FLines.Text := ParseHTML(FLines.Text, FHTML);

  btmp.Free;
end;

procedure TBible.Search(s: string; params: byte; bookset: TBibleSet);
var
  words: TStrings;
  w: string;
  i: integer;
begin
  words := TStringList.Create;
  w := s;

  FLines.Clear;

  FVersesFound := 0;
  FStopSearching := false;

  while w <> '' do words.Add(DeleteFirstWord(w));

  if (params and spWordParts <> spWordParts) then
  begin
    for i:= 0 to words.Count-1 do
    words[i] := ' ' + words[i] + ' ';
  end;

  if words.Count > 0 then
  begin
    for i:=1 to FBookQty do
    if (i-1) in bookset then
    begin
      if FStopSearching then break;
      if Assigned(FOnVerseFound) then FOnVerseFound(Self, FVersesFound, i,0,0,'');
      // just to know that there is a searching -- fire an event
      SearchBook(words, params, i);
    end;
  end;

  words.Free;

  FLasTBible := 0;
  FLastChapter := 0;
  FLastVerse := 0;

  if Assigned(FOnSearchComplete) then FOnSearchComplete(Self);
end;

procedure TBible.StopSearching;
begin
  FStopSearching := true;
end;

function TBible.OpenAddress(s: string; var book, chapter, fromverse, toverse: integer): boolean;
var
  name: string;
  ibook, ichapter, ifromverse, itoverse: integer;
begin
  Result := false;
  book := 1;
  chapter := 1;
  fromverse := 0;
  toverse := 0;

  if not SplitValue(s, name, ichapter, ifromverse, itoverse)
  then Exit;

  name := ' ' + AnsiLowerCase(name) + ' ';

  for ibook := 1 to FBookQty do
  if Pos(name, ' ' + AnsiLowerCase(VarShortNames[ibook]) + ' ') <> 0 then
  begin
    book := ibook;
    chapter := ichapter;
    fromverse := ifromverse;
    toverse := itoverse;

    Result := true;
    Exit;
  end;
end;

procedure TBible.ClearBuffers;
begin
  BookLines.Clear;
  FLines.Clear;
  FLasTBible := 0;
  FLastChapter := 0;
  FLastVerse := 0;
end;

{
   procedures to convert a Russian Bible address (which is stored in xref.dat)
   to equivalent in current module
}
function TBible.AddressToInternal(book,chapter,verse: integer;
  var ibook,ichapter,iverse: integer): boolean;
var
  newtestament, englishbible: boolean;
begin
  Result := true;

  ibook := book;
  ichapter := chapter;
  iverse := verse;

  if (not FBible) or (book > 66) then
  begin
    ibook := 1;
    ichapter := 1;
    iverse := 1;
    Result := false;
    Exit;
  end;

  newtestament := (not FHasOT) and FHasNT;
  englishbible := (newtestament and (ChapterQtys[6] = 16))
    or (ChapterQtys[45] = 16);
    // in English Bible ROMANS follows ACTS instead of JAMES

  if newtestament then
  begin
    if book < 40 then
    begin
      ibook := 1;
      ichapter := 1;
      iverse := 1;
      Result := false;
    end
    else begin
      if englishbible
      then ibook := RusToEngTable[book-39]
      else ibook := book-39;
    end;
  end
  else begin
    if englishbible and (book > 39)
    then ibook := RusToEngTable[book-39] + 39
    else ibook := book;
  end;
end;

function TBible.InternalToAddress(ibook,ichapter,iverse: integer;
 var book,chapter,verse: integer): boolean;
var
  newtestament, englishbible: boolean;
begin
  Result := true;

  book := ibook;
  chapter := ichapter;
  verse := iverse;

  if ichapter > 150 then chapter := 1;

  if (not FBible) or (ibook > 66) then
  begin
    book := 1;
    chapter := 1;
    verse := 1;
    Result := false;
    Exit;
  end;

  newtestament := (not FHasOT) and FHasNT;
  englishbible := (newtestament and (ChapterQtys[6] = 16))
    or (ChapterQtys[45] = 16);
    // in English Bible ROMANS follows ACTS instead of JAMES

  if newtestament then
  begin
    if englishbible
    then book := EngToRusTable[ibook] + 39
    else book := ibook + 39;
  end
  else begin
    if englishbible and (ibook > 39)
    then book := EngToRusTable[ibook-39] + 39
    else book := ibook;
  end;
end;

function TBible.ShortPassageSignature(book,chapter,fromverse,toverse: integer): string;
begin
  if (fromverse <= 1) and (toverse = 0) then
    Result := Format('%s%d', [ShortNames[book],chapter])
  else if (fromverse > 1) and (toverse = 0) then
    Result := Format('%s%d:%d', [ShortNames[book],chapter,fromverse])
  else if toverse = fromverse then
    Result := Format('%s%d:%d', [ShortNames[book],chapter,fromverse])
  else if toverse = fromverse+1 then
    Result := Format('%s%d:%d,%d', [ShortNames[book],chapter,fromverse,toverse])
  else
    Result := Format('%s%d:%d-%d', [ShortNames[book],chapter,fromverse,toverse]);
end;


function TBible.FullPassageSignature(book,chapter,fromverse,toverse: integer): string;
begin
  if (fromverse <= 1) and (toverse = 0) then
    Result := Format('%s %d', [FullNames[book],chapter])
  else if (fromverse > 1) and (toverse = 0) then
    Result := Format('%s %d:%d', [FullNames[book],chapter,fromverse])
  else if toverse = fromverse then
    Result := Format('%s %d:%d', [FullNames[book],chapter,fromverse])
  else if toverse = fromverse+1 then
    Result := Format('%s %d:%d,%d', [FullNames[book],chapter,fromverse,toverse])
  else
    Result := Format('%s %d:%d-%d', [FullNames[book],chapter,fromverse,toverse]);
end;

function TBible.CountVerses(book,chapter: integer): integer;
var
  slines: TStrings;
  i,count: integer;
begin
  slines := TStringList.Create;
  slines.LoadFromFile(FPath + PathNames[book]);

  i := 0;
  count := 0;
  repeat
    if Pos(FChapterSign, slines[i]) > 0 then Inc(count);
    if count = chapter then break;
    Inc(i);
  until i = slines.Count;

  if i = slines.Count then
  begin
    Result := 0;
    slines.Free;
    Exit;
  end;

  count := 0;
  repeat
    if Pos(FVerseSign, slines[i]) > 0 then Inc(count);
    Inc(i);
  until (i = slines.Count) or (Pos(FChapterSign, slines[i]) > 0);

  slines.Free;

  Result := count;
end;

end.

