Страница 1 из 1

Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 17:15:57
Jordan
Приветствую.

Чуть кода.

У меня в проекте, есть базовый объект от которого наследуются остальные. Поля next и prev, нужны для реализации универсального списка, для остальных объектов.

Код: Выделить всё
type
  PGameObject = ^TGameObject;
  TGameObject = object
    Next: PGameObject;
    Prev: PGameObject;
  end;


Сам список который содержит отнаследованные объекты.

Код: Выделить всё
type
  PList = ^TList;
  TList = object
    Head: PGameObject;
    Tail: PGameObject;
    procedure Create();
    procedure Append(Elem: PGameObject);
    procedure Destroy();
    procedure Remove(Elem: PGameObject);
  end;


Решил я сделать менеджер ресурсов. И наследовал от TGameObject -> TResource.

Код: Выделить всё
type
  PResource = ^TResource;
  TResource = object(TGameObject)
    Name: STRING;
  end;


От самого, TResource уже наследовать TImage, TAnimation и т.д

Описание менеджера.

Код: Выделить всё
type
  PResourceManager = ^TResourceManager;
  TResourceManager = object
    Table: ARRAY OF TList;
    procedure Init(Size: INTEGER);
    procedure Destroy();
    function Hash(Src: STRING): INTEGER;
    function Find(Src: STRING): PResource;
  end;


Простая хеш-таблица, коллизии разрешаются с помощью цепочек, реализованных на том самом TList.

Код: Выделить всё
function TResourceManager.Find(Src: STRING): PResource;
var
  H: INTEGER;
  I: PResource; // Здесь проблема ругается, что тип не TGameObject. Почему ругается ведь тип после наследования, грубо говоря один.
begin
  H := Hash(Src);

  I := Table[H].Head;
 
  while (I <> NIL) and (I^.Name <> Src) do
  begin
    I := I^.Next;
  end;
 
  RESULT := I;
end;


Смысл TResource в записи Name: STRING; где хранится путь до ресурса.

Явно, что, я что то не понимаю и упустил, но как правильно сделать не знаю.

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 17:20:17
Дож
А цель-то какая? Надо сперва понять чего хочется.

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 17:33:04
Jordan
Смысл в том, что для объектов которые я наследую от TGameObject, применять единые контейнеры, без написания новых под каждый тип. Да и по логике, именно наследование, позволяет это сделать. Есть конечно вариантная запись, но это больше хак, да и не удобен.

Добавлено спустя 4 минуты 33 секунды:
Если важно, компилю с такими опциями.

Код: Выделить всё
{$mode objfpc}{$H+}
{$ASSERTIONS ON}


Добавлено спустя 16 минут 1 секунду:
Идея такая.

Будет карта. На карте, разные типы объектов.
Путь наследования TGameObject ->TMapObject-> TPerson и т.д

Для объектов есть пул памяти. При уничтожении объекта помещать его в список свободных.

Как это будет происходить.

TMap = Object;
ListUsed: TList; список живых
ListFree: TList; список свободных
Pool : TMemoryPool;
Как будет создаваться, к примеру юнит

псевдокод

procedure TMap.Create(): PPerson;
var
Elem: PPerson;
begin
Elem = ListFree.Head;
if (Elem <> NIL)
Remove(Elem)
Elem //ещё живой, dispose не вызывался, просто изъят из списка
ListUsed.Append(Elem);
end
else
Pool.alloc(Elem, Sizeof(TPerson));
end;

Result := Elem;
end;

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 17:53:54
Дож
А! Извините, я не сразу заметил вопрос, мне этот код было проще пробежать глазами не глядя в комментарии :)

Jordan писал(а): I: PResource; // Здесь проблема ругается, что тип не TGameObject. Почему ругается ведь тип после наследования, грубо говоря один.

I := Table[H].Head;


Присвоение может работать от потомка к предку (потому что потомок является частным случаем предка и всё, что можно проделать с предком корректно проделается и с потомком). В обратную сторону это не верно: вдруг в Table[H].Head хранится не PResource, а что-нибудь другое? Тогда память в объекте будет испорчена и программа будет работать неправильно/упадёт. Поэтому компилятор не может допустить этого присвоения.

Т.к. Вы держите в голове дополнительное знание про код о том, что в этих контейнерах лежат только TResource, Вы должны явно привести тип:
Код: Выделить всё
    I := PResource(Table[H].Head);


А ещё, чтобы получить строгую проверку типов, TList можно объявить через дженерики, но они пока что поддерживаются в fpc не лучшим образом и однозначно рекомендовать их я не могу :)

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 18:02:16
Jordan
Точно, что сразу и не подумал о приведении типов.

Но осталась ошибка.

function TResourceManager.Find(Src: STRING): PResource;
var
H: INTEGER;
I: PResource;
begin
H := Hash(Src);

I := PResource(Table[H].Head);

while (I <> NIL) and (I^.Name <> Src) do
begin
I := I^.Next; //Error: Incompatible types: got "PGameObject" expected "PResource"

end;

RESULT := I;
end;

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 18:05:10
Лекс Айрин
Код: Выделить всё
    procedure Create();
    procedure Append(Elem: PGameObject);
    procedure Destroy();
    procedure Remove(Elem: PGameObject);


Насколько я знаю логику объектов...
1) Не совсем понятна причина конструктора без параметров.
2) Судя по всему, вы перепутали названия объектов. Обычно TList это все же элемент списка.

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 18:10:01
Jordan
Код: Выделить всё
{$mode objfpc}{$H+}
{$ASSERTIONS ON}

Unit List;

interface

Uses
  GameObject;

type
  PList = ^TList;
  TList = object
    Head: PGameObject;
    Tail: PGameObject;
    procedure Create();
    procedure Append(Elem: PGameObject);
    procedure Destroy();
    procedure Remove(Elem: PGameObject);
  end;

implementation

procedure TList.Create();
begin
  Head := NIL;
  Tail := NIL;
end;

procedure TList.Append(Elem: PGameObject);
begin
  Assert(Elem <> NIL);

  if (Head = NIL) then
  begin
    Head := Elem;
    Elem^.Prev := NIL;
  end
  else begin
    Tail^.Next := Elem;
    Elem^.Prev := Tail;
  end;

  Tail := Elem;
  Elem^.Next := NIL;
end;

procedure TList.Destroy();
var
  Curr: PGameObject;
  Next: PGameObject;
begin
  Curr := Head;
   
  while (Curr <> NIL) do
  begin
      Next := Curr^.Next;
      Dispose(Curr);
      Curr := Next;
   end;
   
  Head := NIL;   
  Tail := NIL;
end;

procedure TList.Remove(Elem: PGameObject);
begin
  Assert(Elem <> NIL);

  if (elem = head) then
  begin
    if (elem^.next <> NIL) then
    begin
      head := elem^.next;
      elem^.next^.prev := NIL;
    end
    else begin
      head := NIL;
    end
  end
  else if (elem = tail) then
  begin
    if (elem^.prev <> NIL) then
    begin
      tail := elem^.prev;
      elem^.prev^.next := NIL;
    end
    else begin
      tail := NIL;
    end
  end
  else begin
    elem^.next^.prev := elem^.prev;
      elem^.prev^.next := elem^.next;
  end;

  Dispose(elem);
end;


begin

end.


В этом и хитрость. Обычно в списке есть нода с полями next, prev и указатель на сами данные. Для того что бы не создавать эти лишние ноды, сам объект хранит поля. Получается один вызов new на вставку элемента.

Добавлено спустя 1 минуту 3 секунды:
Это НЕ class, а просто object(недокласс).

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 18:11:49
Дож
I := I^.Next; //Error: Incompatible types: got "PGameObject" expected "PResource"

Это та же самая ошибка. Справа выражение типа PGameObject, а слева — переменная PResource. Решается также

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 18:15:14
Jordan
Дож писал(а):
I := I^.Next; //Error: Incompatible types: got "PGameObject" expected "PResource"

Это та же самая ошибка. Справа выражение типа PGameObject, а слева — переменная PResource. Решается также


Всё исправил. Спасибо за помощь.

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 18:47:08
Лекс Айрин
Jordan писал(а):В этом и хитрость


Имхо, вы перемудрили сами себя.

Создаете объект TList {ноду}, от него наследуете GameObject просто расширяя его полем с типом String... а уже от него расширяете до остальных объектов. Большая часть геморроя исчезнет, так как реализация разделится на "системную" и "прикладную". А сейчас вы пытаетесь перемешать системную и прикладную часть друг с другом.

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 19:08:47
Jordan
Лекс Айрин писал(а):
Jordan писал(а):В этом и хитрость


Имхо, вы перемудрили сами себя.

Создаете объект TList {ноду}, от него наследуете GameObject просто расширяя его полем с типом String... а уже от него расширяете до остальных объектов. Большая часть геморроя исчезнет, так как реализация разделится на "системную" и "прикладную". А сейчас вы пытаетесь перемешать системную и прикладную часть друг с другом.


Вы говорите об этом?

Код: Выделить всё
type
  PNode = ^TNode;
  TNode = Object
    Next: PNode;
    Prev: PNode;
  end;

  PList = ^TList;
  TList = Object
    Head: PNode;
    Tail: PNode;
  end;

  PGameObject = ^TGameObject;
  TGameObject = object(TNode)
    Name: STRING;
  end;
 
  PMapObject = ^TMapObject;
  TMapObject = object(TGameObject)
    X, Y: INTEGER;
  end;


Добавлено спустя 11 минут 3 секунды:
Есть вариант проще, на мой взгляд.

PGameObject = ^TGameObject;
TGameObject = object(TNode)
Name: STRING;
end;

Уже не нужно в цикле типы приводить.

Но без приведения типа, сделать не получится, добавить некий тег описывающий, что за данные и при проверке тега, уже приводить к нужному. Получается вариантная запись, от которой я намеренно ушёл.

Re: Вопрос о наследовании object'ов

СообщениеДобавлено: 16.02.2015 20:20:54
Лекс Айрин
Jordan писал(а): Получается вариантная запись, от которой я намеренно ушёл.


И которую старательно имитируете. Тег уже есть при создании объекта -- его тип.

И не забывайте, кстати, что для полноценной работы со списком нужно где-то хранить указатели на начало списка и на текущую(активную) запись списка. Я бы вообще ноду сделал записью (record).

Код: Выделить всё
PListNode=^TListNode;
TListNode = Record
    Head: PListNode;
    Tail: PListNode;
  end;

TList = Object
   Start, Count:  PListNode;
Construstor Create...
....
Destructor Destroy;
  end;