{
    This file is part of chepersy
    Copyright (c) 2004-2008 by Anton Rzheshevski (chebmaster@mail.ru),

    See the file COPYING.CPS, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}


function MsgRaw(M: TMessageId): WideString;
begin
  Case M of
    Mi_:;
    MI_CGEFILE_UNSUPPORTED: Result:=RuEn('Неподдерживаемая версия chepersy-файла "%0" (v%1). Загрузка невозможна.', 'Unsupported version of chepersy-file "%0" (v%1). The file cannot be read.');
    MI_CGEFILE_ERROR_WRITE: Result:=RuEn('Крах при записи chepersy-файла "%0"', 'Crashed at writing the chepersy-file "%0"');
    MI_CGEFILE_CORRUPT: Result:=RuEn('Chepersy-файл "%0" повреждён и не может быть загружен. %1', 'The chepersy-file "%0" is corrupt and cannot be read. %1');
    MI_CGEFILE_ERROR_READ: Result:=RuEn('Крах при чтении chepersy-файла "%0"', 'Crashed at reading the chepersy-file "%0"');
    MI_ERROR_PROGRAMMER_NO_BAKA: Result:=RuEn('Ошибка программиста.', 'Programmer''s error.')+#10#13#10#13'%0';
    MI_BASKET_NOT_EVERYTHING_IS_FINE_AND_DANDY: Result:=RuEn(
      '/~~ При парсинге лукошка вылезли предупреждения: ~~\'#10#13'%0'#10#13
     +'\~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~/',
      '/~ There were warnings during parsing the basket: ~\'#10#13'%0'#10#13
     +'\~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~/');
    MI_BASKET_FAIL_LOAD: Result:=RuEn('Ошибка чтения данных из лукошка.'#10#13'  %0', 'Failed retrieving data from the basket.'#10#13'  %0');
    MI_BASKET_EXPLAIN_UNKNOWN: Result:=RuEn('Вероятно, файл данных сгенерирован более новой или несовместимой версией программы.', 'Probably the data file was generated by a newer or incompatible version of the program.');

    MI_BASKET_TYPE_SIZE_MISMATCH: Result:=RuEn('Не совпадает размер типа "%0".'#10#13'В текущей версии программы он равен %1, а в файле хранитяс контрольное значение %2.', 'Sizes mismatch for the data type "%0".'#10#13'In the current program version it has size of %1, but the file stores the check value of %2.');
    MI_BASKET_UNKNOWN_OBJECT_FIELD: Result:=RuEn('Класс "%0" не имеет поля "%1:%2". Поскольку опускание объектных полей при чтении не допускается, загрузка была прервана.', 'Class "%0" does not have field "%1:%2". Since omitting objects while reading is not allowed, loading had been terminated.');
    MI_BASKET_FIELD_TYPE_CHANGED: Result:=RuEn('%4 "%0": поле "%1:%2": конверсия из "%3".', '%4 "%0": field "%1:%2": Converting from "%3".');
    MI_BASKET_WRONG_FIELD_TYPE: Result:=RuEn('%4 "%0": поле "%1:%2" опущено, невозможна конверсия из "%3".', '%4 "%0": field "%1:%2": Omitted, can''t convert from "%3".');
    MI_BASKET_UNKNOWN_FIELD: Result:=RuEn('%3 "%0": неизвестное поле "%1:%2".', '%3 "%0": unknown field "%1:%2".');
    MI_BASKET_MISSING_FIELD: Result:=RuEn('%3 "%0": не было поля "%1:%2".', '%3 "%0": had no field "%1:%2".');
    MI_BASKET_UNKNOWN_ENUM: Result:=RuEn('Перечислимый.тип "%0": неизв. "%1", трактуется как "%2".', 'Enum. type "%0": unknown value "%1". Replaced with "%2".');
    MI_BASKET_ENUM_CHANGED: Result:=RuEn('Перечислимый тип "%0": изменился порядок или набор констант.', 'Enum. type "%0": the values order or cast has changed.');
    MI_BASKET_CLASS_SUBSTITUTED: Result:=RuEn('Неизвестный %2 "%0", конверсия в "%1"', 'Unknown %2 "%0" converted to "%1"');
    
    MI_BASKET_UNKNOWN_TYPE_E : Result:=RuEn('ФАТАЛЬНО: Неизвестный тип %0, невозможно обойти.', 'FATAL: Unknown type "%0", cannot be resolved.');
    MI_BASKET_UNKNOWN_TYPE_R: Result:=RuEn('Неизвестный тип "%0", конверсия в "%1".', 'Unknown type "%0", converting to "%1".');
    MI_BASKET_UNKNOWN_CLASS_R: Result:=RuEn('Неизвестный класс "%0", конверсия в предка "%1".', 'Unknown class "%0", converting to its ancestor, "%1".');
    MI_BASKET_UNKNOWN_CLASS_E: Result:=RuEn('ФАТАЛЬНО: Неизвестный класс "%0", невозможно обойти.', 'FATAL: Unknown class "%0", cannot be resolved.');
    
    MI_BASKET_CONVERSION: Result:=RuEn('%1 %0: загрузка требует конверсии.','%1 "%0": loading requires coversion.');
    MI_ERROR_SAVING: Result:=RuEn('Сбой при сохранении в %0','Error saving to %0');
    MI_ERROR_LOADING: Result:=RuEn('Сбой при загрузке из %0','Error loading from %0');
    //: Result:='';
    //: Result:='';
    //: Result:='';
    //: Result:='';
    //: Result:='';
    //: Result:='';

    
    
  end;
end;

  function PCharToString(P: PAnsiChar): AnsiString;
  var
    i: integer;
    p2: PAnsiChar;
  begin
    if not Assigned(p) then Result:=''
    else begin
      p2:=p;
      i:=0;
      While p2^ <> #0 do begin
        inc(p2);
        inc(i);
      end;
      SetLength(Result, i);
      Move(p^, Result[1], i);
    end;
  end;

  function PWideCharToWideString(P: PWideChar): WideString;
  var
    i: integer;
    p2: PWideChar;
  begin
    if not Assigned(p) then Result:=''
    else begin
      p2:=p;
      i:=0;
      While p2^ <> #0 do begin
        inc(p2);
        inc(i);
      end;
      SetLength(Result, i);
      Move(p^, Result[1], i*2);
    end;
  end;

  function BoolChars(b: boolean): widestring;
  begin
    if b then Result:='True' else Result:='False';
  end;

  function VarRecToWide(V: TVarRec): WideString;
  begin
    Case V.Vtype of
      vtInteger:    Result := IntToStr(V.VInteger);
      vtBoolean:    Result := BoolChars(V.VBoolean);
      vtChar:   Result := V.VChar;
      vtWideChar:   Result:=V.VWideChar;
      vtExtended:   Result := FloatToStr(V.VExtended^);
      vtAnsiString:
        {$ifdef fpc}
          Result := Utf8Decode(AnsiString(V.VAnsiString));
        {$else}
          Result := AnsiString(V.VAnsiString);
        {$endif}
      vtWideString: Result := WideString(V.VWideString);
      vtPChar:
        {$ifdef fpc}
          Result := Utf8Decode(Utf8String(PCharToString(V.VPChar)));
        {$else}
          Result := PCharToString(V.VPChar);
        {$endif}
      vtPWideChar:  Result := PWideCharToWideString(V.VPWideChar);
      vtObject:     Result := V.VObject.ClassName;
      vtClass:      Result := V.VClass.ClassName;
      vtPointer: begin
        if Assigned(V.VPointer) then Result:= Format('%Ph',[V.VPointer])
                                else Result:='NIL';
      end;

      //not supported in the FreePascal 1.0.6:
      vtCurrency:   Result := CurrToStr(V.VCurrency^);
      vtVariant:    Result := string(V.VVariant^);

      vtInt64:      Result := IntToStr(V.VInt64^);
    else
      Result:='?unsupported VarRec type?';
    end;
  end;
  

 function WidePos(a, u: WideString): integer;
 var
   j, i: integer;
 begin
   Result:=-1;
   For j:=1 to length(u) do begin
     i:=1;
     While (i < Length(a) + 1) and (a[i] = u[i + j - 1]) do inc(i);
     if i = (Length(a) + 1) then begin
       Result:=j;
       Exit;
     end;
   end;
 end;
 

function WideCOPY(s: WideString; pos, len: integer): WideString;
var i: integer;
begin
  Result:='';
  For i:=pos to pos + len - 1 do begin
    if i > Length(s) then Exit;
    Result:=Result + s[i];
  end;
end;


function WideReplace(u, a, b: WideString): WideString; OVERLOAD;
var p: integer;
    s: WideString;
begin
  s:=u;
  p:=WidePos(a, s);
  While p > 0 do begin
    s:=WideCOPY(s, 1, p - 1) + b + WideCOPY(s, p + Length(a), Length(s));
    p:=WidePos(a, s);
  end;
  Result:=s;
end;


  function PervertedFormat(U: WideString; P: array of const): WideString; //OVERLOAD;
  var
    j: integer;
    b, e: WideString;
  begin
    e:='';
    For j:=0 to High(p) do begin
      b:=VarRecToWide(P[j]);
      if WidePos('%' + IntToStr(j), U) < 1
        then e:=e + '  [' + b + ']  '
        else u:=WideReplace(u, '%' + IntToStr(j), b);
    end;
    if e <> '' then begin
      e:=' +FORMAT ERROR!! ' + e;
    end;
    Result:=u + e;
  end;
  
  function MsgFormat(M: TMessageId; Param: array of const): WideString;
  begin
    Result:=PervertedFormat(MsgRaw(M), param);
  end;

  function RuEn(ru, en: WideString): WideString;
  begin
    if MotherState^.IsRussian then Result:=ru else Result:=en;
  end;

  procedure AddLG(w: WideString);
  begin
    CpsLog.Add(
                {$ifdef fpc}
                  Utf8Encode(w)
                {$else}
                  w
                {$endif}
                );

   if CpsUseWriteLnInAddLog then
   {$ifdef fpc}
    {$ifdef windows}
     WriteLn(w);
    {$else}
     WriteLn(Utf8Encode(w));//unixes mostly use utf-8
    {$endif}
   {$else}
    WriteLn(w);
   {$endif}
  end;
  
  Procedure AddLog(mID: TMessageID; Param: array of const);
  begin
    AddLG(MsgFormat(mID, Param));
  end;
  
  Procedure AddLog(U: WideString; Param: array of const);
  begin
    AddLG(PervertedFormat(u, Param));
  end;

 type
    EDying = class (Exception);
  
  var DyingByMyself: boolean = false;

  procedure AddEM(w: WideString);
  begin
    CpsError.Add(
                {$ifdef fpc}
                  Utf8Encode(w)
                {$else}
                  w
                {$endif}
                );
  end;

  Procedure Die(YellID :TMessageID; Param: array of const);
  {$ifndef fpc}
  var ExceptObject: TObject;
  {$endif}
  begin
    {$ifndef fpc}
     ExceptObject:= System.ExceptObject;
    {$endif}
    if assigned(ExceptObject) and not (ExceptObject is EDying) then begin
      if (ExceptObject is Exception) then AddEM(WideString(
        {ExceptObject.Classname + ': ' +} (ExceptObject as Exception).Message)
      {$ifdef use_chelinfo}
        +  ExplainLineInfo(ExceptAddr)
      {$endif}
      );
    end;
    DyingByMyself:=True;
//    AddLog(YellID, Param);
    AddEM(MsgFormat(YellID, param));
    Raise EDying.Create('(see the Chepersy error log)');
  end;

  Procedure Die(u: WideString; Param: array of const);
  {$ifndef fpc}
  var ExceptObject: TObject;
  {$endif}
  begin
    {$ifndef fpc}
     ExceptObject:= System.ExceptObject;
    {$endif}
    if assigned(ExceptObject) and not (ExceptObject is EDying) then begin
      if (ExceptObject is Exception) then AddEM(WideString(
       { ExceptObject.Classname + ': ' +} (ExceptObject as Exception).Message)
      {$ifdef use_chelinfo}
        +  ExplainLineInfo(ExceptAddr)
      {$endif}
      );
    end;
    DyingByMyself:=True;
    AddEM(PervertedFormat(u, param));
//    AddLog(u, Param);
    Raise EDying.Create('(see the Chepersy error log)');
  end;

  Procedure Die(YellID :TMessageID);
  begin
    Die(YellId, []);
  end;


  Procedure Die(u: WideString);
  begin
    Die(u, []);
  end;


  Procedure AddLog(mID: TMessageID);
  begin
    AddLog(mID, []);
  end;


  Procedure AddLog(U: WideString);
  begin
    AddLog(U, []);
  end;
  
  procedure AddLogOk;
  begin
    AddLog('Ok.');
  end;

