События в игровом движке

unit Graph;
 
uses GraphABC;
 
type
  TColor = Color;
  TPoint = Point;
 
type
  ///Предоставляет процедуры и функции для работы с растровой графикой.
  TDraw = class
  public
    class procedure RDrawLine(x, y, x1, y1: real) := Line(Round(x), Round(y), Round(x1), Round(y1));
    
    class procedure RDrawRect(x, y, x1, y1: real) := DrawRectangle(Round(x), Round(y), Round(x1), Round(y1));
    class procedure RFillRect(x, y, x1, y1: real) := FillRectangle(Round(x), Round(y), Round(x1), Round(y1));
    class procedure RDrawAndFillRect(x, y, x1, y1: real) := Rectangle(Round(x), Round(y), Round(x1), Round(y1));
    
    class procedure RDrawEllipse(x, y, x1, y1: real) := DrawEllipse(Round(x), Round(y), Round(x1), Round(y1));
    class procedure RFillEllipse(x, y, x1, y1: real) := FillEllipse(Round(x), Round(y), Round(x1), Round(y1));
    class procedure RDrawAndFillEllipse(x, y, x1, y1: real) := Ellipse(Round(x), Round(y), Round(x1), Round(y1));
  end;
 
type
  ActionEnum = (Up, Down);
  ///Класс аргументов события.
  TEventArgs = class
  private 
    _ActionType: ActionEnum;
  
  public 
    ///Тип события
    property ActionType: ActionEnum read _ActionType;
    
    constructor(act: ActionEnum);
    begin
      _ActionType := act;
    end;
  end;
 
type
  MouseClickEnum = (NoneClick, RightCLick, LeftClick);
  ///Предоставляет аргументы событий OnMouseClick, OnMouseMove.
  TMouseEventArgs = class(TEventArgs)
  private 
    _ClickState: MouseClickEnum;
    _MoveState: boolean;
    _X, _Y: integer;
  
  public 
    ///Нажатая/отжатая кнопка мыши
    property MouseButton: MouseClickEnum read _ClickState;
    ///Указывает двигалась ли мышь на момент наступления события
    property MoveState: boolean read _MoveState;
    ///X координата курсора на момент наступления события
    property X: integer read _X;
    ///Y координата курсора на момент наступления события
    property Y: integer read _Y;
    
    constructor(cs: MouseClickEnum; act: ActionEnum; ms: boolean; cx, cy: integer);
    begin
      inherited Create(act);
      _ClickState := cs;
      _MoveState := ms;
      _X := cx;_Y := cy;
    end;
    
    function ToString() := Format('event: {0}, {1}', _X, _Y);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;
 
type
  ///Предоставляет аргументы событий OnKeyDown, OnKeyUp.
  TKeyEventArgs = class(TEventArgs)
  private 
    _KeyCode: integer;
  
  public 
      ///Код клавиши
    property KeyCode: integer read _KeyCode;
    
    constructor(kc: integer; act: ActionEnum);
    begin
      inherited Create(act);
      _KeyCode := kc;
    end;
    
    function ToString() := Format('event: {0}', _KeyCode);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;
 
type
  ///Стиль объекта.
  TObjectStyle = record
  public 
    _BorderColor, _FillColor: TColor;
    _BorderWidth: integer;
  
  public 
    ///Цвет границы
    property BorderColor: TColor read _BorderColor write _BorderColor;
    ///Цвет заливки
    property FillColor: TColor read _FillColor write _FillColor;
    ///Толщина границы
    property BorderWidth: integer read _BorderWidth write _BorderWidth;
    
    constructor(bc: TColor := clBlack; fc: TColor := clWhite; bw: integer := 1);
    begin
      BorderColor := bc;
      FillColor := fc;
      BorderWidth := bw;
    end;
    
    ///Устанавливает настройки пера и кисти в соответствии с настройками данного объекта.
    procedure SetSettingsBySelf();
    begin
      SetPenColor(_BorderColor);
      SetBrushColor(_FillColor);
      SetPenWidth(_BorderWidth);
    end;
  end;
 
type
  ///Представляет тип процедуры, вызываемой при событиях OnMouseClick, OnMouseMove.
  TOnMouseActionFunc = procedure(sender: object; eventArgs: TMouseEventArgs);
  ///Представляет тип процедуры, вызываемой при событиях OnKeyDown, OnKeyUp.
  TOnKeyActionFunc = procedure(sender: object; eventArgs: TKeyEventArgs);
 
type
  ///Главный игровой класс.
  TGameObjectBox = class
  public 
    ///Событие нажатия кнопки мыши
    event OnMouseClick: TOnMouseActionFunc;
    ///Событие движения курсора
    event OnMouseMove: TOnMouseActionFunc;
    ///Событие нажатия клавиши
    event OnKeyDown: TOnKeyActionFunc;
    ///Событие отжатия клавиши
    event OnKeyUp: TOnKeyActionFunc;
  
  private 
    _A, _B: TPoint;
    
    function PointIsInBox(p: TPoint) := (p.X >= _A.X) and (p.X <= _B.X) and (p.Y >= _A.Y) and (p.Y <= _B.Y);
  
  public 
    ///Первая вершина прямоугольника
    property A: TPoint read _A write _A;
    ///Вторая вершина прямоугольника
    property B: TPoint read _B write _B;
    
    constructor(pA, pB: TPoint);
    begin
      A := pA;B := pB;
    end;
    
    ///Указывает пересекаются ли границы объектов класса TGameObjectBox.
    function IsCollidedWith(box: TGameObjectBox) := PointIsInBox(box.A) or PointIsInBox(box.B);
    
    procedure TryOnMouseClick(e: TMouseEventArgs);
    begin
      if OnMouseClick <> nil then
        OnMouseClick(self, e);
    end;
    
    procedure TryOnMouseMove(e: TMouseEventArgs);
    begin
      if OnMouseMove <> nil then
        OnMouseMove(self, e);
    end;
    
    procedure TryOnKeyDown(e: TKeyEventArgs);
    begin
      if OnKeyDown <> nil then
        OnKeyDown(self, e);
    end;
    
    procedure TryOnKeyUp(e: TKeyEventArgs);
    begin
      if OnKeyUp <> nil then
        OnKeyUp(self, e);
    end;
  end;
 
type
  ///Тип игрового объекта.
  TGameObject = class(TGameObjectBox)
  private 
    _ObjectStyle: TObjectStyle;
    _IsVisible: boolean;
  
  public 
    ///Стиль объекта
    property ObjectStyle: TObjectStyle read _ObjectStyle write _ObjectStyle;
    ///Видим ли объект
    property IsVisible: boolean read _IsVisible write _IsVisible;
    
    constructor(oS: TObjectStyle);
    begin
      ObjectStyle := oS;
      IsVisible := true;
    end;
    
    ///Перерисовывает объект (вызывается автоматически).
    procedure Draw(); virtual;
    begin
      if not _IsVisible then exit;
      _ObjectStyle.SetSettingsBySelf();
    end;
  end;
  
  ///Тип отрезка.
  TGameLine = class(TGameObject)
  public 
    constructor(pA, pB: TPoint);
    begin
      A := pA;B := pB;
      IsVisible := true;
    end;
    
    ///Перерисовывает объект (вызывается автоматически).
    procedure Draw(); override;
    begin
      inherited Draw();
      TDraw.RDrawLine(_A.X, _A.Y, _B.X, _B.Y);
    end;
  end;
  
  ///Тип прямоугольника.
  TGameRect = class(TGameObject)
  public 
    constructor(pA, pB: TPoint);
    begin
      A := pA;B := pB;
      IsVisible := true;
    end;
    
    ///Перерисовывает объект (вызывается автоматически).
    procedure Draw(); override;
    begin
      inherited Draw();
      TDraw.RDrawAndFillRect(_A.X, _A.Y, _B.X, _B.Y);
    end;
  end;
  
  ///Тип прямоугольника.
  TGameEllipse = class(TGameObject)
  public 
    constructor(pA, pB: TPoint);
    begin
      A := pA;B := pB;
      IsVisible := true;
    end;
    
    ///Перерисовывает объект (вызывается автоматически).
    procedure Draw(); override;
    begin
      inherited Draw();
      TDraw.RDrawAndFillEllipse(_A.X, _A.Y, _B.X, _B.Y);
    end;
  end;
 
type
  ///Управляет игровым процессом.
  TGame = class
  private 
    class _Objects: List<TGameObject>;
    class _Background: TColor;
    
    class function GetItem(i: integer) := _Objects[i];
    
    class function GetCount()  := _Objects.Count;
  
  public 
    class property Items[i: integer]: TGameObject read GetItem;default;
    ///Цвет фона сцены
    class property Background: TColor read _Background write _Background;
    ///Количество объектов
    class property Count: integer read GetCount;
    
    class constructor();
    begin
      if _Objects = nil then
      begin
        _Objects := new List<TGameObject>();
        _Background := clWhite;
      end
    end;
    
    class procedure RedrawAll();
    begin
      if Window.Height = 0 then exit;
      try
        ClearWindow(_Background);
        for var i := 0 to Pred(_Objects.Count) do
          lock _Objects[i] do
            _Objects[i].Draw();
        Redraw();
      except 
        on System.Exception do end;
    end;
    
    ///Добавляет объект на сцену.
    class procedure Add(obj: TGameObject) := _Objects.Add(obj);
    
    ///Удаляет объект со сцены.
    class procedure Remove(obj: TGameObject) := _Objects.Remove(obj);
  end;
 
function MouseClickEnumFromCode(mb: integer): MouseClickEnum;
begin
  case mb of
    0: Result := MouseClickEnum.NoneClick;
    1: Result := MouseClickEnum.LeftClick;
    2: Result := MouseClickEnum.RightCLick
  else raise new System.Exception('Неизвестный код.');
  end;
end;
 
///Обработчик события OnMouseDown.
procedure MouseDown(x, y, mb: integer);
begin
  var SystemMouseEventArgs := new TMouseEventArgs(MouseClickEnumFromCode(mb), ActionEnum.Down, false, x, y);
  
  for var i := 0 to Pred(TGame.Count) do
    TGame[i].TryOnMouseClick(SystemMouseEventArgs);
end;
 
///Обработчик события OnMouseUp.
procedure MouseUp(x, y, mb: integer);
begin
  var SystemMouseEventArgs := new TMouseEventArgs(MouseClickEnumFromCode(mb), ActionEnum.Up, false, x, y);
  
  for var i := 0 to Pred(TGame.Count) do
    TGame[i].TryOnMouseClick(SystemMouseEventArgs);
end;
 
///Обработчик события OnMouseMove.
procedure MouseMove(x, y, mb: integer);
begin
  var SystemMouseEventArgs := new TMouseEventArgs(MouseClickEnumFromCode(mb), ActionEnum.Up, true, x, y);
  
  for var i := 0 to Pred(TGame.Count) do
    TGame[i].TryOnMouseMove(SystemMouseEventArgs);
end;
 
///Обработчик события OnKeyDown.
procedure KeyDown(key: integer);
begin
  var SystemKeyEventArgs := new TKeyEventArgs(key, ActionEnum.Down);
  
  for var i := 0 to Pred(TGame.Count) do
    TGame[i].TryOnKeyDown(SystemKeyEventArgs);
end;
 
///Обработчик события OnKeyUp.
procedure KeyUp(key: integer);
begin
  var SystemKeyEventArgs := new TKeyEventArgs(key, ActionEnum.Up);
  
  for var i := 0 to Pred(TGame.Count) do
    TGame[i].TryOnKeyUp(SystemKeyEventArgs);
end;
 
initialization
  LockDrawing();
  TGame.Create();
  
  OnMouseDown := MouseDown;
  OnMouseUp := MouseUp;
  OnMouseMove := MouseMove;
  
  OnKeyDown := KeyDown;
  OnKeyUp := KeyUp;
 
finalization
  while true do
    TGame.RedrawAll();
end.

uses Crt, GraphABC, Graph;
 
const
  Size = 100;
  Offset = 10;
 
var
  Style: TObjectStyle;
  Rectangle: TGameRect;
 
procedure KeyDownHandler(sender: object; e: TKeyEventArgs);
begin
  var r := sender as TGameRect;
  case e.KeyCode of
    VK_Left:
      begin
        r.A.X -= Offset;
        r.B.X -= Offset;
      end;
    VK_Right:
      begin
        r.A.X += Offset;
        r.B.X += Offset;
      end;
    VK_Up:
      begin
        r.A.Y -= Offset;
        r.B.Y -= Offset;
      end;
    VK_Down:
      begin
        r.A.Y += Offset;
        r.B.Y += Offset;
      end;
  end;
end;
 
begin
  Style := new TObjectStyle(clYellow, clOrange, 6);
  Rectangle := new TGameRect(new TPoint(10, 10), new TPoint(Size, Size));
  Rectangle.ObjectStyle := Style;
  Rectangle.OnKeyDown += KeyDownHandler;
  
  TGame.Add(Rectangle);
  TGame.Background := clLightYellow;
end.