Шарики, ООП Опции

[Bokul]

Тема зародилась Задачник по ООП, а это ее продолжения.
Вот структура того, что я написал (измененная)

1 TGObject -// движущейся графический объект, умеет: 
    // - инитиализировать себя 
    constructor init(speed,color:byte; angle,time:real);
    // - двигаться 
    procedure   moveto;
    //- высчитывать свое новое положение, перекрывается в наследниках
    procedure   calculation; virtual; //abstract; 
    //- вызывается с Supervisor, только в случае столкновения.
    //  Меняем скорость и угол полета.
    procedure   ChangeDirection(speed:byte; angle:real);
    // рисуем себя, перекрывается в наследниках
    procedure   show; virtual; // abstract; 
    // стираем себя, перекрывается в наследниках
    procedure   hide; virtual; // abstract;
    // стирает себя с экрана
    destructor  done; virtual; 

2 TBall - наследник TGObject, теперь это движущейся шарик
     // - добавили новое поле r -радиус, инициализацию остальных полей наследуем
     constructor init(x,y:integer; speed,color:byte; angle,time:real; r:byte);
      procedure   moveto;// перекрываем, наслудуем
      procedure   calculation; virtual;// перекрываем 
      procedure   show; virtual; // тоже перекрываем
      procedure   hide; virtual; // тоже перекрываем
      destructor  done; virtual; // перекрываем, наслудуем
    
  
 3 TItem - элемент списка указателей на  объекты TBall 
     //  инициализирует свою информационную часть
     constructor constructor init(Info:TPGObject; Sled:TPItem);
     destructor  done;// удаляем информационную часть

4 TList - содержит список указателей на объеты типа TBall 
    constructor init;//-инициализирует список
    function     AddItem(Data:TPGObject):boolean; // добавляем новый элемент
    function    DeleteItem(pdel:TPItem):boolean; // удаляем элемент
    destructor  done;//удаляем весь список

Исходники в виде модулей для FPC -  Balls.rar ( 15.06 килобайт ) Кол-во скачиваний: 503



Возникли затруднения в написания модуля TSupervisor, а именно с главным циклом и наследием этого объекта.
Вот, что я написал

uses objects,graphl,UnitTGObject,UnitList;
const
  background=black;
  ballcolor=red;


{------------------------TSupervisor------------------}
type
  TPSuperVisor=^TSuperVisor;
  TSuperVisor=object
     GObjectsList:TList;
     Rect:TRect;
     constructor init(xa,ya,xb,yb:integer);
     function    AddGObject(p:TPGObject):boolean;
     function    DeleteGObject(p:TPGObject):boolean;
     function    ChangeDirection;
     function    Calculation;
     function    WriteResults;
     procedure   main;
     destructor  done;
  end;
constructor TSuperVisor.init;
begin
  GObjectsList.init;
  Rect.assign(xa,ya,xb,yb);
  SetColor(white);
  Rectangle(xa,ya,xb,yb);
end;

function TSuperVisor.AddGObject(p:TPGObject);
begin
  AddGObject:=GObjectsList.AddItem(p);
end;

function TSuperVisor.DeleteGObject(p:TPGObject):boolean;
begin
  DeleteTPGObject:=GObjectsList.DeleteItem(p);
end;

procedure TSuperVisor.main;
begin
end;

destructor TSuperVisor.done;
begin
  GObjectsList.done;
  ClearDevice;
end;

[volvo]

Значит, так... По порядку:

С такой реализацией списка тоже можно жить... Неудобно, правда, но ничего - это FPC, в конце концов - перегрузишь операторы - будет смотреться получше... Теперь о том, какие огрехи и в каком порядке у тебя были замечены:

1. function TSuperVisor.DeleteGObject(p:TPGObject):boolean;
   begin
     // DeleteGObject:=GObjectsList.DeleteItem(p);
   end;
   

   - несоответствие типов, копаться, чтобы исправить это я не стал, просто закомментировал вызов процедуры, т.к. не совсем понятно, почему при добавлении к списку функция AddItem получает указатель типа TPGObject, а при удалении DeleteItem требует указатель типа TPItem...
2. Довольно опасно - потому, что проблема не синтаксическая, а логическая - ошибку придется искать отладкой:
   

   constructor TBall.init(x,y:integer; speed,color:byte; angle,time:real; r:byte);
   begin
      inherited init(speed,color,angle,time);
      pos_x:=x;
      pos_y:=y;
      r:=radius; // <--- Здесь !!! Надо - наоборот: radius := r
      show;
      oldx:=pos_x;
      oldy:=pos_y;
   end;
   

   В твоем варианте привело к тому, что для всех создаваемых объектов - шаров радиус оставался нулевым => ничего не отчерчивалось, хотя и должно было бы...
3. Объясни смысл введения переменных oldx, oldy, если ты все равно сначала скрываешь объект, потом его пересчитываешь, и уже с новыми координатами заново перерисовываешь? Я заменил вот эту процедуру:
   

   procedure TBall.hide;
   begin
     bufcolor:=GetColor;
     SetColor(GetBkColor);
     // Circle(oldx,oldy,radius);
     Circle(pos_x,pos_y,radius);
     SetColor(bufcolor);
   end;
   

   - теперь она работает...
   
   + к этому - еще кое что... Зачем ты делаешь bufcolor членом объекта? Памяти много доступной? Это тебе только кажется - ее скоро не будет хватать... Ты переменной bufcolor пользуешься локально - для временного сохранения текущего цвета отрисовки, так? Шарик твой что-то выигрывает от того, что знает, какой текущий цвет установлен? Нет... Тогда зачем ему лишняя информация? Убирай это из объекта...
4. О скорости выполнения ты тоже, как я вижу, особенно не задумываешься, сколько у тебя будет шариков максимально? 5? 10? А если понадобится имитировать "броуновское движение" и счет пойдет на сотни? Зачем просто так занимать ресурсы и время никому не нужной работой? Я про это:
   

     procedure TBall.calculation;
     begin
       // Здесь ты все время переводишь градусы в радианы
       pos_x:=pos_x+round(cos(degtorad(l))*v*t);
       pos_y:=pos_y+round(sin(degtorad(l))*v*t);
       l:=ArcTanDeg(pos_y,pos_x);
     end;
   

   
   +
   

     function TBall.ArcTanDeg(x,y:real):real;
     begin
       // А здесь - наоборот, радианы в градусы ???
       ArcTanDeg:=radtodeg(arctan2(x,y));
     end;
   

   
   Проще (и быстрее, кстати) сразу решить, что все углы хранятся в радианах (раз уж тригонометрические функции Паскаля работают именно с радианами)... Я понимаю, что пользователю как раз удобнее задавать угол в градусах, НО ведь есть конструктор!!! Пускай он возьмет на себя эту работу:
   

     // Получать от вызывающего класса угол в градусах ...
     constructor TGObject.init(speed,color:byte; angle,time:real);
     begin
       v:=speed;
       col:=color;
       // Здесь - сразу переводить в радианы, и работать только в радианах
       l:=angle;
       t:=time;
     end;
   

   Преимущество: это делается только при инициализации класса, а следовательно - только однажды, причем, функцию перевода Grad -> Rad можно заменить константой Pi / 180

Вот та основная программа, которая у меня заработала (шарики корректно двигаются, естественно, ни о каких коллизиях - ни об отталкиваниях от стенок, ни об ударениях друг об друга - пока нет речи, это добавится позднее...)

uses
  objects,crt, graph,
  ball, UnitTGObject, UnitItem, UnitList;
const
  background=black;
  ballcolor=red;


{------------------------TSupervisor------------------}
type
  TPSuperVisor=^TSuperVisor;
  TSuperVisor=object
     GObjectsList:TList;
     Rect:TRect;
     constructor init(xa,ya,xb,yb:integer);
     function    AddGObject(p:TPGObject):boolean;
     function    DeleteGObject(p:TPGObject):boolean;
     function    ChangeDirection: boolean;
     function    Calculation: boolean;
     function    WriteResults: boolean;
     procedure   main;
     destructor  done;
  end;
constructor TSuperVisor.init;
var i: integer;
begin
  GObjectsList.init;
  Rect.assign(xa,ya,xb,yb);
  SetColor(white);
  Rectangle(xa,ya,xb,yb);

  for i := 1 to 10 do
    AddGObject(new(tpball, init(random(getmaxx - 20) + 10,
                                random(getmaxy - 20) + 10,
                           2, red, random(360), 1, 5)));
end;

function TSuperVisor.AddGObject(p:TPGObject);
begin
  AddGObject:=GObjectsList.AddItem(p);
end;

function TSuperVisor.DeleteGObject(p:TPGObject):boolean;
begin
  // DeleteGObject:=GObjectsList.DeleteItem(p);
end;

procedure TSuperVisor.main;
var p: TPItem;
begin

  repeat

    delay(10);
    p := GObjectsList.List;
    while p <> nil do begin
      p^.data^.moveto;
      p := p^.next;
    end;

    // При нажатии на Esc - выходим из цикла
    if keypressed and (readkey = #27) then break
    else
      while keypressed do readkey;

  until false;
end;

// Это - пока пустые функции, похоже, Calculation здесь вообще не нужна - 
// вычислениями будет заниматься конкретный объект, а не Наблюдатель
function    TSuperVisor.ChangeDirection: boolean;
begin end;
function    TSuperVisor.Calculation: boolean;
begin end;
function    TSuperVisor.WriteResults: boolean;
begin end;


destructor TSuperVisor.done;
begin
  GObjectsList.done;
  ClearDevice;
end;


var
  grdriver, grmode, errcode: smallint;
  sv: TSuperVisor;

begin
  grDriver := d8bit; grMode := m800x600;
  InitGraph(grDriver, grMode, '');
  ErrCode := GraphResult;
  if ErrCode <> grOk then begin
    Writeln('Graphics error:', GraphErrorMsg(ErrCode));
    writeln('Press Enter to halt()'); readln; halt(100);
  end;


  SV.init(1, 1, getmaxx, getmaxy);
  SV.main;
  SV.done;
end.