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

Форум для изучающих FPC и их учителей.

Модератор: Модераторы

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

Сообщение Jordan » 16.02.2015 17:15:57

Приветствую.

Чуть кода.

У меня в проекте, есть базовый объект от которого наследуются остальные. Поля 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; где хранится путь до ресурса.

Явно, что, я что то не понимаю и упустил, но как правильно сделать не знаю.
Jordan
новенький
 
Сообщения: 13
Зарегистрирован: 19.12.2013 09:44:54

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

Сообщение Дож » 16.02.2015 17:20:17

А цель-то какая? Надо сперва понять чего хочется.
Аватара пользователя
Дож
энтузиаст
 
Сообщения: 899
Зарегистрирован: 12.10.2008 16:14:47

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

Сообщение Jordan » 16.02.2015 17:33:04

Смысл в том, что для объектов которые я наследую от 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;
Jordan
новенький
 
Сообщения: 13
Зарегистрирован: 19.12.2013 09:44:54

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 не лучшим образом и однозначно рекомендовать их я не могу :)
Аватара пользователя
Дож
энтузиаст
 
Сообщения: 899
Зарегистрирован: 12.10.2008 16:14:47

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

Сообщение Jordan » 16.02.2015 18:02:16

Точно, что сразу и не подумал о приведении типов.

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

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;
Jordan
новенький
 
Сообщения: 13
Зарегистрирован: 19.12.2013 09:44:54

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

Сообщение Лекс Айрин » 16.02.2015 18:05:10

Код: Выделить всё
    procedure Create();
    procedure Append(Elem: PGameObject);
    procedure Destroy();
    procedure Remove(Elem: PGameObject);


Насколько я знаю логику объектов...
1) Не совсем понятна причина конструктора без параметров.
2) Судя по всему, вы перепутали названия объектов. Обычно TList это все же элемент списка.
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 5723
Зарегистрирован: 19.02.2013 16:54:51
Откуда: Волгоград

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

Сообщение Jordan » 16.02.2015 18:10:01

Код: Выделить всё
{$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(недокласс).
Jordan
новенький
 
Сообщения: 13
Зарегистрирован: 19.12.2013 09:44:54

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

Сообщение Дож » 16.02.2015 18:11:49

I := I^.Next; //Error: Incompatible types: got "PGameObject" expected "PResource"

Это та же самая ошибка. Справа выражение типа PGameObject, а слева — переменная PResource. Решается также
Аватара пользователя
Дож
энтузиаст
 
Сообщения: 899
Зарегистрирован: 12.10.2008 16:14:47

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

Сообщение Jordan » 16.02.2015 18:15:14

Дож писал(а):
I := I^.Next; //Error: Incompatible types: got "PGameObject" expected "PResource"

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


Всё исправил. Спасибо за помощь.
Jordan
новенький
 
Сообщения: 13
Зарегистрирован: 19.12.2013 09:44:54

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

Сообщение Лекс Айрин » 16.02.2015 18:47:08

Jordan писал(а):В этом и хитрость


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

Создаете объект TList {ноду}, от него наследуете GameObject просто расширяя его полем с типом String... а уже от него расширяете до остальных объектов. Большая часть геморроя исчезнет, так как реализация разделится на "системную" и "прикладную". А сейчас вы пытаетесь перемешать системную и прикладную часть друг с другом.
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 5723
Зарегистрирован: 19.02.2013 16:54:51
Откуда: Волгоград

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

Сообщение Jordan » 16.02.2015 19:08:47

Лекс Айрин писал(а):
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;

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

Но без приведения типа, сделать не получится, добавить некий тег описывающий, что за данные и при проверке тега, уже приводить к нужному. Получается вариантная запись, от которой я намеренно ушёл.
Jordan
новенький
 
Сообщения: 13
Зарегистрирован: 19.12.2013 09:44:54

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;
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 5723
Зарегистрирован: 19.02.2013 16:54:51
Откуда: Волгоград


Вернуться в Обучение Free Pascal

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 8

Рейтинг@Mail.ru