unit dpglib.utils;

interface
uses
   System.Classes,
   Generics.Collections,
   dpgrtl.types,
   dpglib.types;

type
   cType = (ctOther, ctNumber, ctAlpha, ctAlnum, ctPrint);
   sType = set of cType;

   TCharFormater  = function ( c: char): AnsiString;

function IsNumber(   c: AnsiChar): boolean;
function IsAlpha(    c: AnsiChar): boolean;
function IsAlnum(    c: AnsiChar): boolean;
function IsPrint(    c: AnsiChar): boolean;

function StringToID( s: AnsiString): AnsiString;


function DelphiCharFormater(  c     : AnsiChar) : AnsiString;


function DelphiTokenFormater( t     : integer;
                              tm    : ITokenManager = nil) : AnsiString;

function TokenSetToStr(       pBS   : TByteSet;
                              pTM   : ITokenManager = nil): AnsiString;

{
function DelphiTokenFormater( t     : integer;
                              v     : TStringList = nil) : AnsiString;

function TokenSetToStr(       pBS   : TByteSet;
                              pVocab: TStringList     = nil): AnsiString;
}

function CharSetToStr(        pBS   : TCharSet;
                              pFmt  : TCharFormater= nil): AnsiString; overload;

function CharSetToStr(        pBS   : TByteSet;
                              pFmt  : TCharFormater= nil): AnsiString; overload;
implementation
uses
   System.SysUtils,
   System.StrUtils;

var
   c     : AnsiChar;
   cTable: array [AnsiChar] of sType;

// ----------------------------------------------------------------------------
// GetStringOfToken
// ----------------------------------------------------------------------------
{
function GetStringOfToken( t: integer; v: TStringList): AnsiString;
var
   i     : integer;
   p     : integer;
   name  : AnsiString;
   value : AnsiString;
   str   : AnsiString;
begin
   result   := '';

   for i:=0 to v.Count-1 do
   begin
      name  := v.Names[i];
      value := v.ValueFromIndex[i];

      if StrToIntDef( value,-1) = t then
      begin
         if name[1] = '"' then
         begin
            name := Copy(name,2,Length(name)-2);
            result := 'LT_' + name;

            result := AnsiReplaceText( result, '$', '_DOLLAR_');
            result := AnsiReplaceText( result, '/', '_SLASH_');
            result := AnsiReplaceText( result, ':', '_COLON_');
            result := AnsiReplaceText( result, '.', '_DOT_');

            result := AnsiReplaceText( result, 'LT__', 'LT_');

            break;
         end

         else
         begin
            result := 'TT_' + name;
            break;
         end;
      end;
   end;
end;
}

// ----------------------------------------------------------------------------
// GetStringOfToken
// ----------------------------------------------------------------------------
function GetStringOfToken( t: integer; tm: ITokenManager): AnsiString;
var
   ts    : ITokenSymbol;
   ss    : IStringSymbol;
   
begin
   result := '';
   ts     := tm.TokenSymbolByType[t];

   if Assigned(ts) then
   begin
      ts.QueryInterface( IStringSymbol, ss);

      if Assigned(ss) then
      begin
         if ss.Lbl <> ''
            then result := ss.Lbl
            else result := 'LT_'+ss.ID;

         result := AnsiString( AnsiReplaceText( String(result), '#', '_SHARP_'));
         result := AnsiString( AnsiReplaceText( String(result), '*', '_STAR_'));
         result := AnsiString( AnsiReplaceText( String(result), '$', '_DOLLAR_'));
         result := AnsiString( AnsiReplaceText( String(result), '/', '_SLASH_'));
         result := AnsiString( AnsiReplaceText( String(result), ':', '_COLON_'));
         result := AnsiString( AnsiReplaceText( String(result), '.', '_DOT_'));

         result := AnsiString( AnsiReplaceText( String(result), 'LT__', 'LT_'));
      end

      else
         result := 'TT_' +ts.ID;
   end
end;

// ----------------------------------------------------------------------------
// DelphiCharFormater
// ----------------------------------------------------------------------------
function DelphiCharFormater( c: AnsiChar): AnsiString;
var
   tmp: string;

begin
   if isPrint( c) then
      if c = '''' then
         tmp := ''''''''''
      else
         tmp := '''' + c + ''''
   else
      tmp := '#' + IntToStr( ord(c));

   result := AnsiString( tmp);
end;

// ----------------------------------------------------------------------------
// DelphiTokenFormater
// ----------------------------------------------------------------------------
function DelphiTokenFormater( t: integer; tm: ITokenManager): AnsiString;
begin
   if tm <> nil then
      result := GetStringOfToken( t, tm);

   if result = '' then
      result := AnsiString( 'TT_' + Format('%3.3d',[t]));
end;
{
function DelphiTokenFormater( t: integer; v: TStringList): AnsiString;
begin
   if v <> nil then
      result := GetStringOfToken( t, v);

   if result = '' then
      result := 'TT_' + Format('%3.3d',[t]);
end;
}

// ----------------------------------------------------------------------------
// TokenSetToStr
// ----------------------------------------------------------------------------
function TokenSetToStr(    pBS   : TByteSet;
                           pTM   : ITokenManager): AnsiString;
var
   t           : integer;
   firstToken  : integer;
   lastToken   : integer;

begin
   result   := '';
   t        := 0;

   while t <= 255 do
   begin
      // ------------------------------------------------------------
      // Find the first "bit" of the range
      // ------------------------------------------------------------
      while (not (t in pBS)) and (t <= 255) do
         INC(t);

      // ------------------------------------------------------------
      // Check that we are reached the end
      // ------------------------------------------------------------
      if t = 256 then
         break;

      // ------------------------------------------------------------
      // OK, we found the first "bit" of the range
      // ------------------------------------------------------------
      firstToken := t;

      // ------------------------------------------------------------
      // Fin the last "bit" of the range
      // ------------------------------------------------------------
      while (t in pBS) and (t <= 255) do
         INC(t);

      lastToken := pred(t);

      // ------------------------------------------------------------
      // Append "," to the result if this founded range is not the
      // first in the result.
      // ------------------------------------------------------------
      if result <> '' then
         result := result + ',';

      // ------------------------------------------------------------
      // Build the first "bit" into the result
      // ------------------------------------------------------------
      result := result + DelphiTokenFormater( firstToken, pTM);

      // ------------------------------------------------------------
      // Build range if the firstChar not equals to the lastChar
      // ------------------------------------------------------------
      if firstToken <> lastToken then
         result := result + '..' + DelphiTokenFormater( lastToken, pTM);
   end;
end;

{
function TokenSetToStr(    pBS   : TByteSet;
                           pVocab: TStringList): AnsiString;
var
   t           : integer;
   firstToken  : integer;
   lastToken   : integer;

begin
   result   := '';
   t        := 0;

   while t <= 255 do
   begin
      // ------------------------------------------------------------
      // Find the first "bit" of the range
      // ------------------------------------------------------------
      while (not (t in pBS)) and (t <= 255) do
         INC(t);

      // ------------------------------------------------------------
      // Check that we are reached the end
      // ------------------------------------------------------------
      if t = 256 then
         break;

      // ------------------------------------------------------------
      // OK, we found the first "bit" of the range
      // ------------------------------------------------------------
      firstToken := t;

      // ------------------------------------------------------------
      // Fin the last "bit" of the range
      // ------------------------------------------------------------
      while (t in pBS) and (t <= 255) do
         INC(t);

      lastToken := pred(t);

      // ------------------------------------------------------------
      // Append "," to the result if this founded range is not the
      // first in the result.
      // ------------------------------------------------------------
      if result <> '' then
         result := result + ',';

      // ------------------------------------------------------------
      // Build the first "bit" into the result
      // ------------------------------------------------------------
      result := result + DelphiTokenFormater( firstToken, pVocab);

      // ------------------------------------------------------------
      // Build range if the firstChar not equals to the lastChar
      // ------------------------------------------------------------
      if firstToken <> lastToken then
         result := result + '..' + DelphiTokenFormater( lastToken, pVocab);
   end;
end;
}

// ----------------------------------------------------------------------------
// CharSetToStr
// ----------------------------------------------------------------------------
function CharSetToStr(     pBS   : TCharSet;
                           pFmt  : TCharFormater): AnsiString;
var
   c        : integer;
   firstChar: AnsiChar;
   lastChar : AnsiChar;

begin
   result   := '';
   c        := 0;

   while c <= 255 do
   begin
      // ------------------------------------------------------------
      // Find the first "bit" of the range
      // ------------------------------------------------------------
      while (not (AnsiChar(c) in pBS)) and (c <= 255) do
         INC(c);

      // ------------------------------------------------------------
      // Check that we are reached the end
      // ------------------------------------------------------------
      if c = 256 then
         break;

      // ------------------------------------------------------------
      // OK, we found the first "bit" of the range
      // ------------------------------------------------------------
      firstChar := AnsiChar(c);

      // ------------------------------------------------------------
      // Find the last "bit" of the range
      // ------------------------------------------------------------
      while (AnsiChar(c) in pBS) and (c <= 255) do
         INC(c);

      lastChar := pred(AnsiChar(c));

      // ------------------------------------------------------------
      // Append "," to the result if this founded range is not the
      // first in the result.
      // ------------------------------------------------------------
      if result <> '' then
         result := result + ',';

      // ------------------------------------------------------------
      // Build the first "bit" into the result
      // ------------------------------------------------------------
      result := result + DelphiCharFormater( firstChar);

      // ------------------------------------------------------------
      // Build range if the firstChar not equals to the lastChar
      // ------------------------------------------------------------
      if firstChar <> lastChar then
         result := result + '..' + DelphiCharFormater( lastChar);
   end;
end;

// ----------------------------------------------------------------------------
// CharSetToStr
// ----------------------------------------------------------------------------
function CharSetToStr(     pBS   : TByteSet;
                           pFmt  : TCharFormater): AnsiString;
var
   c        : integer;
   firstChar: AnsiChar;
   lastChar : AnsiChar;

begin
   result   := '';
   c        := 0;

   while c <= 255 do
   begin
      // ------------------------------------------------------------
      // Find the first "bit" of the range
      // ------------------------------------------------------------
      while (not (c in pBS)) and (c <= 255) do
         INC(c);

      // ------------------------------------------------------------
      // Check that we are reached the end
      // ------------------------------------------------------------
      if c = 256 then
         break;

      // ------------------------------------------------------------
      // OK, we found the first "bit" of the range
      // ------------------------------------------------------------
      firstChar := AnsiChar(c);

      // ------------------------------------------------------------
      // Fin the last "bit" of the range
      // ------------------------------------------------------------
      while (c in pBS) and (c <= 255) do
         INC(c);

      lastChar := AnsiChar(pred(c));

      // ------------------------------------------------------------
      // Append "," to the result if this founded range is not the
      // first in the result.
      // ------------------------------------------------------------
      if result <> '' then
         result := result + ',';

      // ------------------------------------------------------------
      // Build the first "bit" into the result
      // ------------------------------------------------------------
      result := result + DelphiCharFormater( firstChar);

      // ------------------------------------------------------------
      // Build range if the firstChar not equals to the lastChar
      // ------------------------------------------------------------
      if firstChar <> lastChar then
         result := result + '..' + DelphiCharFormater( lastChar);
   end;
end;

// ----------------------------------------------------------------------------
// IsNumber
// ----------------------------------------------------------------------------
function IsNumber( c: AnsiChar): boolean;
begin
   result := ctNumber in cTable[c];
end;

// ----------------------------------------------------------------------------
// IsAlpha
// ----------------------------------------------------------------------------
function IsAlpha( c: AnsiChar): boolean;
begin
   result := ctAlpha in cTable[c];
end;

// ----------------------------------------------------------------------------
// IsAlnum
// ----------------------------------------------------------------------------
function IsAlnum( c: AnsiChar): boolean;
begin
   result := ctAlnum in cTable[c];
end;

// ----------------------------------------------------------------------------
// IsPrint
// ----------------------------------------------------------------------------
function IsPrint( c: AnsiChar): boolean;
begin
   result := ctPrint in cTable[c];
end;

// ================================================================================================
// Convert string to a valid identifier name
// ================================================================================================
function StringToID( s: AnsiString): AnsiString;
var
   i: integer;
   c: AnsiChar;

begin
   result := '';

   for c in s do
   begin
      if IsAlnum(c) then
         result := result +c

      else if IsPrint(c) then
         case c of
            ' ' : result := result + '_SPACE_';
            '!' : result := result + '_EXCL_';
            '#' : result := result + '_SHARP_';
            '$' : result := result + '_DOLLAR_';
            '§' : result := result + '_PARA_';
            '%' : result := result + '_PERCENT_';
            '&' : result := result + '_AND_';
           '''' : result := result + '_APOSTROPHE_';
            '(' : result := result + '_LPAREN_';
            ')' : result := result + '_RPAREN_';
            '*' : result := result + '_STAR_';
            '+' : result := result + '_PLUS_';
            ',' : result := result + '_COMMA_';
            '-' : result := result + '_MINUS_';
            '.' : result := result + '_DOT_';
            '/' : result := result + '_SLASH_';

            ':' : result := result + '_COLON_';
            ';' : result := result + '_SEMI_';
            '<' : result := result + '_LT_';
            '=' : result := result + '_EQ_';
            '>' : result := result + '_GT_';
            '?' : result := result + '_QUESTION_';
            '@' : result := result + '_AT_';

            '[' : result := result + '_LBRACKET_';
            '\' : result := result + '_BS_';
            ']' : result := result + '_RBRACKET_';
            '^' : result := result + '_CARET_';

            '{' : result := result + '_LCURLY_';
            '|' : result := result + '_OR_';
            '}' : result := result + '_RCURLY_';
            '~' : result := result + '_TILDE_';
            else  result := result + Format('_0x2.2%x_',[c]);
         end;
   end;

   if (Length(result) > 0) and (RightStr( result, 1) = '_') then
      result := Copy( result, 1, Length(result)-1);
end;
// ****************************************************************************
//                                                  Initialization/finalization
// ****************************************************************************
initialization
   for c:=#0 to #255 do
      cTable[c] := [ctOther];

   cTable[  ' '] := [ctPrint];
   cTable[  '!'] := [ctPrint];
   cTable[  '"'] := [ctPrint];
   cTable[  '#'] := [ctPrint];
   cTable[  '$'] := [ctPrint];
   cTable[  '§'] := [ctPrint];
   cTable[  '%'] := [ctPrint];
   cTable[  '&'] := [ctPrint];
   cTable[ ''''] := [ctPrint];
   cTable[  '('] := [ctPrint];
   cTable[  ')'] := [ctPrint];
   cTable[  '*'] := [ctPrint];
   cTable[  '+'] := [ctPrint];
   cTable[  ','] := [ctPrint];
   cTable[  '-'] := [ctPrint];
   cTable[  '.'] := [ctPrint];
   cTable[  '/'] := [ctPrint];

   cTable[  '0'] := [ctPrint, ctNumber, ctAlnum];
   cTable[  '1'] := [ctPrint, ctNumber, ctAlnum];
   cTable[  '2'] := [ctPrint, ctNumber, ctAlnum];
   cTable[  '3'] := [ctPrint, ctNumber, ctAlnum];
   cTable[  '4'] := [ctPrint, ctNumber, ctAlnum];
   cTable[  '5'] := [ctPrint, ctNumber, ctAlnum];
   cTable[  '6'] := [ctPrint, ctNumber, ctAlnum];
   cTable[  '7'] := [ctPrint, ctNumber, ctAlnum];
   cTable[  '8'] := [ctPrint, ctNumber, ctAlnum];
   cTable[  '9'] := [ctPrint, ctNumber, ctAlnum];

   cTable[  ':'] := [ctPrint];
   cTable[  ';'] := [ctPrint];
   cTable[  '<'] := [ctPrint];
   cTable[  '='] := [ctPrint];
   cTable[  '>'] := [ctPrint];
   cTable[  '?'] := [ctPrint];
   cTable[  '@'] := [ctPrint];

   cTable[  'A'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'B'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'C'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'D'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'E'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'F'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'G'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'H'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'I'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'J'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'K'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'L'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'M'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'N'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'O'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'P'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'Q'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'R'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'S'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'T'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'U'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'V'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'W'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'X'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'Y'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'Z'] := [ctPrint, ctAlpha, ctAlnum];

   cTable[  '['] := [ctPrint];
   cTable[  '\'] := [ctPrint];
   cTable[  ']'] := [ctPrint];
   cTable[  '^'] := [ctPrint];
   cTable[  '_'] := [ctPrint];
   cTable[  '`'] := [ctPrint];

   cTable[  'a'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'b'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'c'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'd'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'e'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'f'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'g'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'h'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'i'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'j'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'k'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'l'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'm'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'n'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'o'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'p'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'q'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'r'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  's'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  't'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'u'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'v'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'w'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'x'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'y'] := [ctPrint, ctAlpha, ctAlnum];
   cTable[  'z'] := [ctPrint, ctAlpha, ctAlnum];

   cTable[  '{'] := [ctPrint];
   cTable[  '|'] := [ctPrint];
   cTable[  '}'] := [ctPrint];
   cTable[  '~'] := [ctPrint];
end.