Unit MathDef;

// =======================================================================
//              * * * Интерфейс с внешними модулями * * *
// =======================================================================

Interface

uses Classes, Init;

// =======================================================================
type
  PModuleVersion      = ^TModuleVersion;
  TModuleVersion      = record
    Major, Minor      : word;
    Description       : PChar;
  end;
// =======================================================================
//                    * * * Объявления VMT - таблиц * * *
// =======================================================================
// Интерфейс на слагаемое модели
type
  PAdden = ^IAdden;
  IAdden = object
    // Возвращает описание
    function Description:PChar;virtual;stdcall;abstract;
    // Возвращает текстовую запись формулы (в формате BASIC - а)
    function StdName:PChar;virtual;stdcall;abstract;
    // Возвращает текстовую запись имени коэффициента
    function StdBName:PChar;virtual;stdcall;abstract;
    // Возвращает минимально необходимую размерность факторного
    // пространства, в котором находятся агрументы функции GetValue.
    function RequiredDimension:integer;virtual;stdcall;abstract;
    // Возвращает значение в точке M
    procedure Value(M:pointer;var Res:double);
      virtual;stdcall;abstract;
  end;

// =======================================================================
// Интерфейс на модель
type
  PModel = ^IModel;
  IModel = object
    // Возвращает описание
    function  Description:PChar;virtual;stdcall;abstract;
    // Возвращает минимально необходимую размерность факторного
    // пространства, в котором находятся агрументы функции GetValue.
    function  RequiredDimension:integer;virtual;stdcall;abstract;
    // Возвращает число слагаемых
    function  AddenCount:integer;virtual;stdcall;abstract;
    // Возвращает интерфейс на указанное слагаемое
    function  Addens(Index:integer):PAdden;virtual;stdcall;abstract;
    // Возвращает значение в точке M для коэффициентов B
    procedure Value(M:pointer;B:pointer;var Res:double);
      virtual;stdcall;abstract;
    // Возвращает текстовую запись формулы - РЕАЛИЗОВАНА ЗДЕСЬ !
    function  StdName:string;
  end;

// =======================================================================
// Интерфейс на генератор плана
type
  PGen = ^IGen;
  IGen = object
    // Возвращает описание
    function  Description:PChar;virtual;stdcall;abstract;
    // Возвращает размеры матрицы, в которую записывается план. Число
    // строк - количество опытов, число столбцов - количество фактров.
    procedure RequiredDimensions(var nRows,nCols:integer);
      virtual;stdcall;abstract;
    // Генерация плана.
    procedure Generate(Mat:pointer);virtual;stdcall;abstract;
    // План предполагает использование модели:
    function DefaultModel:PModel;virtual;stdcall;abstract;
  end;

// =======================================================================
//     Приложеие создает один экземпляр  объекта  "TMathDefinition".  Этот
// объект используется для доступа к функциям всех интерфейсов всех  внеш-
// них модулей.
// =======================================================================
type
  TMathDefinition=class(TObject)
  private
    // Библиотеки с модулями
    _Libraries        : TList;
    // Имена библиотек
    _Modules          : TStringList;
    // Описания модулей
    _Versions         : TList;
    // Слагаемые моделей (из всех модулей)
    _Addens           : TList;
    // Модели (из всех модулей)
    _Models           : TList;
    // Генераторы (из всех модулей)
    _Generators       : TList;
    function          GetnModules:integer;
    function          GetnAddens:integer;
    function          GetnModels:integer;
    function          GetnGenerators:integer;
    function          GetModuleName(Index:integer):string;
    function          GetModuleDescription(Index:integer):string;
    function          GetAdden(Index:integer):PAdden;
    function          GetModel(Index:integer):PModel;
    function          GetGen(Index:integer):PGen;
  public
    constructor       Create;
    destructor        Free;
    //                Очистка всех списков
    procedure         Clear;
    //                Добавление в списки содержимого указанной библиотеки
    function          AppendModule(LibName:string):boolean;
    //                Добавление в списки содержимого всех библиотек из
    //                каталога 'Directory'. Возвращает количество найденных
    //                модулей.
    function          FindModules(Directory:string):integer;
    //                Поиск индексов по именам. Для генераторов и моделей в
    //                качестве уникальных имен используются описания, для
    //                слагаемых - стандартные имена
    function          AddenByStdName(StdName:string):integer;
    function          ModelByName(Name:string):integer;
    function          GenByName(Name:string):integer;
    //                Доступ к именам, моделям и генераторам.
    property          ModuleCount : integer read GetnModules;
    property          AddenCount : integer read GetnAddens;
    property          ModelCount : integer read GetnModels;
    property          GenCount : integer read GetnGenerators;
    property          Modules[Index : integer]
                        : string read GetModuleName;
    property          Descriptions[Index : integer]
                        : string read GetModuleDescription;
    property          Addens[Index : integer] : PAdden read GetAdden;
    property          Models[Index : integer] : PModel read GetModel;
    property          Gens[Index : integer] : PGen read GetGen;
  end;

var
  ExternalModules : TMathDefinition;

// =======================================================================
Implementation
// =======================================================================
// Статические глобальные типы и переменные - используются перечислителями
// =======================================================================

uses Windows, SysUtils, MiscRoutines; // in '..\MiscRoutines.Pas';

function IModel.StdName;
var
 i : integer;
begin
  Result:='Y=';
  for i:=0 to AddenCount-2 do
  begin
    Result:=Result+
      string(Addens(i)^.StdBName)+'*('+
      string(Addens(i).StdName)+')+';
  end;
  Result:=Result+
    string(Addens(AddenCount-1)^.StdBName)+'*('+
    string(Addens(AddenCount-1)^.StdName)+')';
end;

const
  ADENUM_OK           =1;
  ADENUM_CANCEL       =0;
  MODENUM_OK          =1;
  MODENUM_CANCEL      =0;
  PLENUM_OK           =1;
  PLENUM_CANCEL       =0;

type
  // Получение описания модуля
  TGetModuleVersion   = function(PVI:PModuleVersion):integer;stdcall;
  // Функции обратного вызова для перечислителей
  TEnumAddenProc      = function(Adden:PAdden):integer;stdcall;
  TEnumModelProc      = function(Model:PModel):integer;stdcall;
  TEnumGenProc        = function(Gen:PGen):integer;stdcall;
  // Перечислители
  TAddensEnumerate    = function(EnumProc:TEnumAddenProc):integer;stdcall;
  TModelsEnumerate    = function(EnumProc:TEnumModelProc):integer;stdcall;
  TGensEnumerate      = function(EnumProc:TEnumGenProc):integer;stdcall;

const
  strIternErr : string = 'Внутренняя ошибка: ';

var
  DestList : TList;

function EnumAddenProc(Adden:PAdden):integer;stdcall;
begin
  if((DestList=nil)or(Adden=nil)) then
  begin
    Error(strIternErr+'EnumAddenProc: pDestList = nil');
    Result:=ADENUM_CANCEL;
    exit;
  end;
  DestList.Add(Adden);
  Result:=ADENUM_OK;
end;

function EnumModelProc(Model:PModel):integer;stdcall;
begin
  if((DestList=nil)or(Model=nil)) then
  begin
    Error(strIternErr+'EnumModelProc: pDestList = nil');
    Result:=ADENUM_CANCEL;
    exit;
  end;
  DestList.Add(Model);
  Result:=ADENUM_OK;
end;

function EnumGenProc(Gen:PGen):integer;stdcall;
begin
  if((DestList=nil)or(Gen=nil)) then
  begin
    Error(strIternErr+'EnumGenProc: pDestList = nil');
    Result:=ADENUM_CANCEL;
    exit;
  end;
  DestList.Add(Gen);
  Result:=ADENUM_OK;
end;

// =======================================================================
// Реализация методов объекта "TMathDefinition"
// =======================================================================
// Создание
constructor TMathDefinition.Create;
begin
  _Modules:=TStringList.Create;
  _Versions:=TList.Create;
  _Libraries:=TList.Create;
  _Addens:=TList.Create;
  _Models:=TList.Create;
  _Generators:=TList.Create;
  Clear;
end;

// =======================================================================
// Уборка мусора
destructor TMathDefinition.Free;
var
  i : integer;
begin
  if(_Libraries.Count>0) then
    for i:=0 to _Libraries.Count-1 do
      if(_Libraries[i]<>nil) then
        Windows.FreeLibrary(DWORD(_Libraries[i]));
  _Libraries.Destroy;
  _Modules.Destroy;
  if(_Versions.Count>0) then
    for i:=0 to _Versions.Count-1 do
      if(_Versions[i]<>nil) then
        Dispose(_Versions[i]);
  _Versions.Destroy;
  _Addens.Destroy;
  _Models.Destroy;
  _Generators.Destroy;
  Clear;
  Inherited Free;
end;

// =======================================================================
// Подключение внешнего модуля
function TMathDefinition.AppendModule(LibName:string):boolean;
var
  hlib   : HModule;
  gmv    : TGetModuleVersion;
  pvi    : PModuleVersion;
  aenum  : TAddensEnumerate;
  menum  : TModelsEnumerate;
  genum  : TGensEnumerate;
begin
  Result:=False;
  hlib:=Windows.LoadLibrary(PChar(LibName));
  if(hlib=0) then
  begin
    Warning('Ошибка загрузки внешнего модуля "'+LibName+'".');
    exit;
  end;
  gmv:=Windows.GetProcAddress(hlib,'GetModuleVersionInfo');
  if(@gmv=nil) then
  begin
    Warning('Ошибка загрузки внешнего модуля "'+LibName+'":'+#13+
      'не найдена точка входа в процедуру "GetModuleVersionInfo()".');
    exit;
  end;
  _Modules.Add(LibName);
  New(pvi);
  gmv(pvi);
  _Versions.Add(pvi);
  _Libraries.Add(pointer(hlib));
  aenum:=Windows.GetProcAddress(hlib,'AddensEnumerate');
  if(@aenum<>nil) then
  begin
    DestList:=_Addens;
    aenum(EnumAddenProc);
  end;
  menum:=Windows.GetProcAddress(hlib,'ModelsEnumerate');
  if(@menum<>nil) then
  begin
    DestList:=_Models;
    menum(EnumModelProc);
  end;
  genum:=Windows.GetProcAddress(hlib,'GensEnumerate');
  if(@genum<>nil) then
  begin
    DestList:=_Generators;
    genum(EnumGenProc);
  end;
  Result:=True;
end;

function TMathDefinition.FindModules;
var
  SearchRec : TSearchRec;
  Found     : integer;
begin
  Found:=FindFirst(Directory+'\*.dll',faAnyFile,SearchRec);
  while Found = 0 do
  begin
    IniForm.Msg('Модуль: '+Directory+'\'+SearchRec.Name);
    AppendModule(Directory+'\'+SearchRec.Name);
    Found:=FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  Result:=ModuleCount;
end;

procedure TMathDefinition.Clear;
begin
  _Libraries.Clear;
  _Modules.Clear;
  _Versions.Clear;
  _Addens.Clear;
  _Models.Clear;
  _Generators.Clear;
end;

function TMathDefinition.GetnModules:integer;
begin
  Result:=_Modules.Count;
end;

function TMathDefinition.GetnAddens:integer;
begin
  Result:=_Addens.Count;
end;

function TMathDefinition.GetnModels:integer;
begin
  Result:=_Models.Count;
end;

function TMathDefinition.GetnGenerators:integer;
begin
  Result:=_Generators.Count;
end;

function TMathDefinition.GetModuleName(Index:integer):string;
begin
  if(Index>=_Modules.Count) then
  begin
    Error(strIternErr+'Index > _Modules.Count');
    Result:='';
  end
  else
    Result:=_Modules.Strings[Index];
end;

function TMathDefinition.GetModuleDescription(Index:integer):string;
begin
  if(Index>=_Versions.Count) then
  begin
    Error(strIternErr+'Index > _Modules.Count');
    Result:='';
  end
  else
    Result:=string(PModuleVersion(_Versions[Index])^.Description);
end;

function TMathDefinition.GetAdden(Index:integer):PAdden;
begin
  if(Index>=_Addens.Count) then
  begin
    //Error(strIternErr+'Index > _Addens.Count');
    write(strIternErr+'Index > _Addens.Count');
    Result:=(PAdden(_Addens.Items[0]));
  end
  else
    Result:=PAdden(_Addens.Items[Index]);
end;

function TMathDefinition.GetModel(Index:integer):PModel;
begin
  if(Index>=_Models.Count) then
  begin
    Error(strIternErr+'Index > _Models.Count');
    Result:=(PModel(_Models.Items[0]));
  end
  else
    Result:=(PModel(_Models.Items[Index]));
end;

function TMathDefinition.GetGen(Index:integer):PGen;
begin
  if(Index>=_Generators.Count) then
  begin
    Error(strIternErr+'Index > _Generators.Count');
    Result:=(PGen(_Generators.Items[0]));
  end
  else
    Result:=(PGen(_Generators.Items[Index]));
end;

function TMathDefinition.AddenByStdName(StdName:string):integer;
var
  i : integer;
begin
  Result:=-1;
  for i:=0 to _Addens.Count-1 do
  begin
    if(PAdden(_Addens.Items[i])^.StdName=StdName) then
    begin
      Result:=i;
      exit;
    end;
  end;
end;

function TMathDefinition.ModelByName(Name:string):integer;
var
  i : integer;
begin
  Result:=-1;
  for i:=0 to _Models.Count-1 do
  begin
    if(PModel(_Models.Items[i])^.Description=Name) then
    begin
      Result:=i;
      exit;
    end;
  end;
end;

function TMathDefinition.GenByName(Name:string):integer;
var
  i : integer;
begin
  Result:=-1;
  for i:=0 to _Generators.Count-1 do
  begin
    if(PGen(_Generators.Items[i]).Description=Name) then
    begin
      Result:=i;
      exit;
    end;
  end;
end;


end.

