Перзистентная система (Дельфи/ФриПаскаль)

UPD. на 12 июня 2022: проект продолжает развиваться, набирая новые потрясающие фичи - условная альфа окончательной парадигмы завершена в декабре 2019-го.

НО оно теперь неотрывная часть моего игрового движка, коий сейчас в последнем и решительном рефакторинге. Можно будет пощупать, Оценочно - осень 2022. http://freepascal.ru/forum/viewtopic.php?f=10&t=10058

-------------------------------------

P.P.S Изменил лицензию, взяв за основу лицензию от RTL ФриПаскаля. Теперь можно включать и в программы с закрытыми исходниками..

P.S. "Что молчишь? Поймал, что-ли?" (с) Чебурашка. Вы не молчите, голуби. Мне тоже обидно: делал-делал, вырезал, чтобы другие пользоваться могли, а в ответ - ни  звука.

2. Страничка проекта: http://www.chebmaster.ru/soft/libs_pers.html (где можно скачать 250Кб архив, включающий все исходники и откомпилированный тест (2 штуки: из-под Дельфи и из-под FPC))

3. Зачем:
С минимально возможными усилиями придаёт любой структуре данных свойство сохраняемости в файл. Можно так игру сохранять, можно в собственном формате модели хранить, можно целиком состояние программы сохранять на выходе - включая все открытые меню и нажатые клавиши.

4. Главная плюшка:
ПОЧТИ 100% ОБРАТНАЯ СОВМЕСТИМОСТЬ ФАЙЛОВ ДАННЫХ! Можно добавлять/менять/удалять поля классов как пожелаете - всё равно загрузится, не чихнув.  То же относится к enumerated типам :)

5. Добавочная плюшка:
Валидатор, не позволяющий по рассеянности "забыть" зарегистрировать какое-либо поле, либо перепутать порядок полей.

Текст тестовой программы:

{$include mo_globaldefs.h}
{$apptype console}
{$ifdef fpc}
  {$memory 10000, 300000000}
{$endif}
program test;
uses 
  SysUtils, typinfo, mo_classes;


type
  TMyEnum = (Svobu, Dabu, Zigzag, ZugZug);
  
  TMyArray = array[0..13] of SmallInt;

  TTestData = class (TTrulyPersistent)
  public
    a: string;
    c: TMyEnum;
    r: TMyArray;
    b: integer;
    d, e: TTestData;
    procedure RegisterFields; override;
  end;

var 
  TestData: TTestData;
  FileVersion: AnsiChar;

procedure TTestData.RegisterFields;
begin
  RegType(TypeInfo(TMyEnum));
  //New in v5: a hack around the lack of RTTI for static arrays in Delphi.
  RegType('TMyArray', TypeInfo(SmallInt), SizeOf(TMyArray));
  RegField('a', @a, TypeInfo(string));
  RegField('c', @c, TypeInfo(TMyEnum));
  RegField('r', @r, 'TMyArray');
  RegField('b', @b, TypeInfo(integer));
  RegField('d', @d, TypeInfo(TTestData));
  RegField('e', @e, TypeInfo(TTestData));
end;

begin
  Try
    AddLog('Started.');
    ClassesRegistrationStart;
    RegClass(TTestData);
    if not FileExists(ExtractFilePath(ParamStr(0)) + 'testsave.cge')
    then begin
      TestData:=TTestData.Create;
      TestData.a:='My Nice AnsiString';
      TestData.b:=777;
      Testdata.c:=ZugZug;
      TestData.r[8]:=33;
      TestData.d:=TTestData.Create;

     //A circular reference. Scary?.. Hell, no!
      TestData.d.e:=TTestData.Create;
      TestData.d.d:=Testdata.d;
      TestData.d.e.e:=TestData;

      WriteLn('Writing...');
      //Format 0 (zero, not o) is the simple but fast.
      //format s includes MD5 sum calculation and checking.
      SaveGame(TestData, 's', ExtractFilePath(ParamStr(0)) + 'testsave.cge');
      WriteLn('Success.');
      WriteLn;
      TestData.Free;
    end;
    WriteLn('Loading...');
    TestData:=LoadGame(
       ExtractFilePath(ParamStr(0)) + 'testsave.cge', 'TTestData') as TTestData;
    WriteLn('Success.');
    WriteLn('a = ', TestData.d.e.e.a);
    WriteLn('b = ', TestData.d.e.e.b);
    WriteLn('c = ', GetEnumName(TypeInfo(TMyEnum), ord(TestData.d.e.e.c)));
    WriteLn('r[8] = ',TestData.d.e.e.r[8]);
  Except
    WriteLn ('Error! ', (ExceptObject as Exception).Message);
  End;
  ReadLn;
end.   

Документация (оформлена в виде комментариев):

type
  TTrulyPersistent = class(TObject)
  protected
    ....
  public
    procedure RegisterFields; virtual;
    procedure BeforeSaving(); virtual;
    procedure AfterLoading(); virtual; //is called after the object is loaded.
  end;

  CTrulyPersistent = class of TTrulyPersistent;

// **************** SAVING / LOADING ROUTINES **********************

  procedure SaveGame(o: TObject; {$ifdef cge}m: TMessageId;{$endif}
                     version: AnsiChar; TargetName: AnsiString);
  function LoadGame({$ifdef cge}m: TMessageId;{$endif} SourceName: AnsiString;
                    ClassName: WideString): TObject;

  procedure PrepareToSave(TargetName: String; version: AnsiChar;
                          Signature: WideString);
  procedure PrepareToLoad(SourceName: String; Signature: WideString);
  procedure DoneSaving(FlushToFile: boolean; FileName: AnsiString);
  procedure DoneLoading();
  
var
 //could be '0' (basic), 's' (safe, with md5 check) or 'p' (packed).
  VersionOfLoadedFile: AnsiChar;

  {$ifndef cge}
    {$include mo_tmid_public.h}
  {$endif}

type
  {$ifdef fpc}
    {$include mo_dyna.h}
  {$else}
    {$include mo_dyna_h_delphi.inc}
  {$endif}

type
  TFieldOperation = (fio_Load, fio_Save, fio_Skip);
  TCustomTypeProcessingProc = procedure
        (PField: pointer; Op: TFieldOperation); register;

// ****************** INIT PROCEDURES ********************************
  procedure ClassesRegistrationStart;
//!!!  procedure ClassesRegistratonEnd;

{   RegClass must be called for each descendant of TTrulyPersistent.
      The best place to do it is the initialization procedure of the module.
      Automatically calls the "Register" constructor of a class.
}
  procedure RegClass(C: CTrulyPersistent);

// ****************** FIELD PROCEDURES *********************************

{
    These intended to be called only and only from within the
    "Register" constructor of TTrulyPersistent descendants.
       (Why didn't I make them its methods...?)
    Types should be registered first.   )
}
  procedure RegField(name: string; Pf: pointer; PI: PTypeInfo); overload;
{ example: RegField('Merry rabbits', @bunnies, TypeInfo(TBunnies));
    -- where "bunnies" is a field of type TBunnies}

  //for types thad do not have RTTI (namely, static arrays in Delphi)
  procedure RegField(name: string; Pf: pointer; TypeString: string); overload;

  //Skipped fields: for texture ids, and other stuff that
  //  cannot be safely restored from the save.
  procedure RegSkip(name: string; Pf: pointer; PI: PTypeInfo); overload;
  procedure RegSkip(name: string; Pf: pointer; TypeString: string); overload;
  //For pointers and non-registrable classes (technically, pointers too)
  procedure RegSkipPtr(name: string; Pf: pointer);

// ****************** TYPE PROCEDURES ************************************

{   These could be called from anywhere after the classes registration started.
      Even from the "Register" constructor.}

{   This bunny registers binary types (i.e. ones that could be
      dumped into a stream directly, without caring about their structure).
      ...I wish TypeInfo or TypeData structures had a size field
      so that pointing it manually would be unnecessary. Dreams, dreams... :(  }
  procedure RegType(Info: PTypeInfo; Size: Integer);  overload;
  
{   This bunny acts the same as the one above, with two following exceptions:
      A). It assumes type size is equal to pointer size (4 bytes), and
      B). It could be used to register enumeration types which need
          a special approach (saved as DWORDs, loaded either as
          DWORDs or via special converting routine - depending on the
          parsing results).
        (Do NOT forget to use the $MINENUMSIZE 4 compiler directive!)}
  procedure RegType(Info: PTypeInfo);  overload;

{   This bunny registers array types.
      Since the lack of RTTI it goes via string IDs.}
  procedure RegType(StringID: ansistring;
                    Info: PTypeInfo; Size: Integer);  overload;

{   This bunny allows to deal with complex types like strings,
      dynamic arrays - even non-persistent objects! - by introducing
      a custom processing procedure (see template in mo_typeprocs.inc).
    Its only limitation is that it assumes base type to be a pointer,
      so field size is always pointer-sized (4 bytes on 32-bit platform).}
  procedure RegType(Info: PTypeInfo; Proc: TCustomTypeProcessingProc); overload;

{   These bunnies register types of corresponding classes.
      Note, that persistent classes are registered automatically
      when RegClass() is called. So you need to evoke
      RegType(C: CTrulyPersistent) manually only in cases of
      cross-reference (while class A has fields of type B,
      and class B - fields of type A)}
  procedure RegType(C: CTrulyPersistent);  overload;

Круто.
А можно сделать так чтобы они сами регистрились? Ну вызвал универсальную процедуру, которая сама регистрит все поля, либо большинство (хотя бы элементарных типов)?

Поддержка версий - это пять.
А что будет, если одноименное поле сменит тип?

Поддерживается ли сохранение/восстановление циклических графов и объектов?

>>А что будет, если одноименное поле сменит тип?
Будет опущено при чтении (заполнено нулями). Кстати, спасибо вам, я сейчас баг отловил: работает программа нормально, но в журнал пишет, что поле сменило тип на integer (а я его переделал в WideString). Буду выскребать.

/~ There were warnings during parsing the basket: ~\
Class "TTESTDATA": field "A" is of type "INTEGER", not "STRING". Omitted.
Class "TTESTDATA": missing field "R" of type "TMYARRAY". Filled with zeroes.
Enum. type "TMYENUM": the values order or cast has changed.
Class "TTESTDATA": loading requires coversion.
\~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~/

>>Поддерживается ли сохранение/восстановление циклических графов и объектов?
Дык. В тестовом примере как раз такой и создаётся.

>>А можно сделать так чтобы они сами регистрились?
Э-ех... If wishes were fishes...
Сам очень хотел бы, но RTTI слишком неполная (во Фри ПАскале чуть пополнее, но этого всё равно недостаточно). Без перечисления ручками, увы, никак.

P.S. Да, насчёт изменения типа поля: планирую сделать конвертируемыми (чтобы integer'ы и float'ы разного размера преобразовывались автоматом), но пока до этого не дошёл.

Мелкобаг удавлен, архив перезакачан.

Упс... По рассеянности забыл в одном файле лицензию поменять. Исправлено, перезакачано.

Cheb

Отлично! Дельфи не дельфи, но хороший интерфейс скроет... многое скроет...

Можно поподробнее в тексте результаты твоих трудов? (я дельфи юзаи и множество сохраняемых/восстанавливаемых обджиктов тоже)

>> , но хороший интерфейс скроет... многое скроет...
Эээ... В каком смысле?

>> Можно поподробнее в тексте результаты твоих трудов?
То есть в каком смысле - "в тексте"? Подробно описать, как работает? Так мне неделю роман писать придётся. Мне кажется, для использования в виде "чёрного ящика" я достаточно хорошо всё объяснил самим вышеприведённым кодом, а на полное описание, если честно, сил сейчас просто нет.

Могу примерно расписать некоторые особенности внутреннего устройства.
1. Один из столпов - TNameSpace, пространство имён, позволяющее заменить все строки целочисленными индексами, и работать уже с ними. У программы своё пространство имён (глобальное), у файла данных - своё (локальное). При загрузке один раз строится таблица преобразования второго в первое. При сохранении просто пишется в файл глобальное пространство имён.
2. Часть информации о зарегистрированных типах (имя, размер) пишется в .cge файл.
3. Таблица полей (двумерная, <классов>х<полей>) пишется в файл целиком.
4. Зарегистрированные типы делятся на простые (бинарные), которые тупо пишутся в файл как есть (идущие подряд для быстроты пишутся как один кусок), и сложные, для каждого из которых регистрируется своя процедура сохранения/загрузки. Строка, например, пишется как длина, затем само тело строки - и т.п. Чтобы пользовать систему на 100%, надо уметь писать такие процедуры - подробности см. в mo_classes.pas и mo_typeprocs.inc
5. Перечислимые типы - исключение. Они пишутся всегда напрямую, как бинарные, а читаются - или как бинарные (если таблицы имён их значений у программы и .cge-файла совпадают), либо по таблице преобразования (которая строится если не совпадают). В связи с этим, обязательна директива {$minenumsize 4} - регистратор всегда предполагает, что перечислимый тип имет размер dword.
6. Загрузка класса. После парсинга для каждого класса строится сценарий загрузки. Если описания класса в программе и файле совпадают идеально (все поля того же размера и на тех же местах, используемые перечислимые типы идентичны), то класс грузится по сценарию (подряд идущие бинарные поля - единым куском, и д.п). Если хоть на волосок не совпадают - сценарий отменяется, и каждый экземпляр класса грузится по одному полю за раз, с расстановкой на нужные места, что замедляет его загрузку раза в два-три. В журнале это отражается как "Class "TTESTDATA": loading requires coversion."
7. Структура сохранения .cge-файлов выглядит несколько сумбурно. Это связано с тем, что в оригинале часть её процедур принадлежит ядру моего движка, а часть - игровому модулю-dll, а диспетчеры памяти у них разные. (Ouch.) А надо было оптимизировать так, чтобы устранить повторное копирование данных. И обеспечить сохранение, кроме файла, в контейнер в памяти.
8. Я написал эту систему, добился работоспособности, оказался совершенно недоволен её быстродействием, и полностью перелопатил некоторые части, добившись увеличения быстродействия раза в 4 (чисто за счёт алгоритмов). Документации я не веду, имея дурную привычку держать всё в памяти, а оптимизация усложнила код будь здоров. Поэтому я не люблю лазить в уже отлаженные. работающие модули. У меня мозги начинают трещать ото всей этой зауми, мысль обычно : "И это *я* написал?.. Ужас какой".
9. То же о формате .cge-файлов. Я сам предпочитаю рассматривать их как "чёрный ящик" с определёнными функциями. Мозги надо очистить и дефрагментировать для следующих подвигов. А то этот монстр есть, а в движке даже GUI не валялся.

>>//A circular reference. Scary?.. Hell, no!
А как у тебя с указателями? допускаются ссылки полей классов друг на друга?
TTestData1= class (TTrulyPersistent)
  public
    a: byte;
    ...................
  end;

TTestData = class (TTrulyPersistent)
  public
    pa: pbyte;
    .................
  end;
var
    TestData1:TTestData1;
    TestData2:TestData12;
........................
TestData2.pa:=@TestData1.a

Как раз сегодня закончил работу над собственной подобной системой. Как ни странно, очень похоже %)

>>Правка: укоротил по просьбе особо нервных трудящихся.
Ok. Всё равно длинно, но хоть читать страницу теперь можно.

2.
>>А как у тебя с указателями? допускаются ссылки полей классов друг на друга?
Указатели *вообще* не допускаются. Никакие. Поля можно иметь, но только через RegSkip, и после чтения они nil.
Указатель же на поле другого класса - это вообще изврат. Полный. Как и работа с полями "не своего" класса. Вся идеология классов основана на том, что класс - это самодостаточная единица, состоящая из информации и методов её обработки. Если приходится лазить к полям другого класса - значит, выбрана неверная структура данных.

И - внимание, тесты показывают, что вызов виртуального метода класса часто оказывается быстрее, чем обращение напрямую к его полям из метода другого класса (у меня при отладке был случай, когда такая "матрёшка", всего лишь двойной вложенности, оказалась медленнее десятка вызовов виртуальных методов, каждый из которых, в свою очередь, писал данные в TMemoryStream. А я ведь всего лишь одно поле типа integer прочитал). Компилятор ведь не дурак, хранит Self в регистре, так что обращение к "своим" полям полностью бесплатно - не дороже, чем к глобальным переменным.

Cheb
Ты это имеешь ввиду? горизонтальную прокрутку? разрешение 1024х768

В таком случае тебе тоже надо редактировать.
или я не понял - чего куда прокручивать?

Ок, Объясняю: форум отлично умеет подгонять обычный текст к ширине экрана. Но это работает, пока кто-нибудь не пихнёт кусок кода с дли-и-и-инными строками. В коде перенос строк запрещён, и один такой фрагмент растягивает всю страницу вплоть до бесконечности. Естественно, обычный текст при этом тоже растягивается под новую ширину, и становится нечитабельным.

Поэтому, правилом элементарной вежливости является обработка кода перед вставлением его в форум. Обычной "стрижки" под ширину в 80 символов вполне достаточно.

Образец: замени
Properties.Add('FStringMatrix', @FStringMatrix, TypeInfo(TStrangeDummyArray), False).SetAdditionalProperties(iatMatrix, aetString, assArraySafe);
на
Properties.Add('FStringMatrix', @FStringMatrix,
TypeInfo(TStrangeDummyArray), False).SetAdditionalProperties(
iatMatrix, aetString, assArraySafe);

- и страница сразу придёт в норму. Обрати внимание, что мой код везде аккуратно подстрижен, чтобы не вызывать принудительного скроллинга. Всегда проверяй в превью посты, содержащие код. И тогда не будешь портить людям жизнь по незнанию, а форумчане не будуд тихо материть тебя, прокручивая длинные тексты, и карма твоя очистится.

Cheb
Da Stranger

Юзайте скрипт Sark7 для opera/ff и не парьтесь.

>>и не парьтесь
Я не "парюсь", я указываю на элементарные правила вежливости. И я не желаю химичить с настройками браузера. И я ненавижу, когда всякие умники тыкают меня носом в моё неумение подключать какие-то супер-пупер-навороты. И Файрфокс - это мой выбор, и менять его на всякие Оперы я не намерен - скорее уж уйду с этого форума, мне и без того есть, где общаться.

А вообще, этой проблемой давно уже должны были озаботиться админы форума. Я видел форумные движки, где при вставке чего-то здорового разъезжается в ширину лишь тот пост, куда оно вставлено, а остальные остаются нормальной ширины.