
program extractor3;



{$I DIRECTIVES}

uses
  Classes, SysUtils,
  IOUtils,
  FLRE, FLREUnicode;


function SubStr(const aSource: string; aStart: integer; aEnd: integer = MAXINT): string;
begin
  result := Copy(aSource, aStart, aEnd - aStart + 1);
end;

var
  txt: string;
  i, j, k: integer;
  
  c: char; 
  l: integer; 
  d: boolean; 
  
  tc, tl, td: TStringList; 
  re: TFLRE; 

type
  TReplacement = class
    function Callback(const aInput: PFLRERawByteChar; const aCaptures: TFLRECaptures): TFLRERawByteString;
  end;

function TReplacement.Callback(const aInput: PFLRERawByteChar; const aCaptures: TFLRECaptures): TFLRERawByteString;

var
  index: integer;
begin
  with aCaptures[1] do
    result := FLREPtrCopy(aInput, Start, Length);
  with aCaptures[2] do
    index := Pred(StrToInt(FLREPtrCopy(aInput, Start, Length)));
  if result = 'directive' then
    result := td[index]
  else if result = 'literal' then
    result := tl[index];
end;

begin
  tc := TStringList.Create;
  tl := TStringList.Create;
  td := TStringList.Create;

  if (ParamCount = 1) and FileExists(ParamStr(1))then
    txt := TFile.ReadAllText(ParamStr(1))
  else
    txt := TFile.ReadAllText('extractor3.pp');

  i := 1;
  j := 0;
  k := 0;

  c := #0;
  l := 0;
  d := FALSE;

  while i <= Length(txt) do
  begin
    if c <> #0 then 
    begin
      if ((c = '{') and (txt[i] = '}'))
      or ((c = '(') and (txt[i] = ')') and (txt[i - 1] = '*'))
      or ((c = '/') and (i < Length(txt)) and (txt[i + 1] in [#10, #13])) then
      begin
        k := i;
        tc.Append(SubStr(txt, j, k));
        txt := Format('%s%s', [SubStr(txt, 1, j - 1), SubStr(txt, k + 1)]);
        c := #0;
        i := j - 1;
      end;
    end else

      if l <> 0 then 
      begin
        if txt[i] = '''' then
        begin
          Inc(l);
          if (l mod 2 = 0) and (i < Length(txt)) and (txt[i + 1] <> '''') then
          begin
            k := i;
            tl.Append(SubStr(txt, j, k));
            txt := Format('%s_literal_%d_%s', [SubStr(txt, 1, j - 1), tl.Count, SubStr(txt, k + 1)]);
            l := 0;
            i := j - 1;
          end;
        end;
      end else

        if d then 
        begin
          if txt[i] = '}' then
          begin
            k := i;
            td.Append(SubStr(txt, j, k));
            txt := Format('%s_directive_%d_%s', [SubStr(txt, 1, j - 1), td.Count, SubStr(txt, k + 1)]);
            d := FALSE;
            i := j - 1;
          end;
        end else

          if ((txt[i] = '{') and (i < Length(txt)) and (txt[i + 1] <> '$'))
          or ((txt[i] = '(') and (i < Length(txt)) and (txt[i + 1] = '*'))
          or ((txt[i] = '/') and (i < Length(txt)) and (txt[i + 1] = '/')) then
          begin
            j := i;
            c := txt[i];
          end else

            if txt[i] = '''' then
            begin
              j := i;
              l := 1;
            end else

              if ((txt[i] = '{') and (i < Length(txt)) and (txt[i + 1] = '$')) then
              begin
                j := i;
                d := TRUE;
              end;

    Inc(i);
  end;

  TFile.WriteAllText('1.txt', txt);

  with TStringList.Create do
  begin
    for i := 0 to tc.Count - 1 do Append(Format('comment=[%s]', [tc[i]]));
    for i := 0 to tl.Count - 1 do Append(Format('literal=[%s]', [tl[i]]));
    for i := 0 to td.Count - 1 do Append(Format('directive=[%s]', [td[i]]));
    SaveToFile('2.txt');
    Free;
  end;

  re := TFLRE.Create('_([a-z]+)_(\d+)_', []);
  with TReplacement.Create do
  begin
    txt := re.ReplaceCallback(txt, Callback);
    Free;
  end;
  re.Free;

  TFile.WriteAllText('3.txt', txt);

  tc.Free;
  tl.Free;
  td.Free;
end.
