source: trunk/Packages/Kernel/Kernel.Graphics.pas

unit Kernel.Graphics;

interface

uses
  SysUtils, Generics.Collections;

type
  TDesktop = class;

  { TPoint }

  TPoint = record
    X: Integer;
    Y: Integer;
    class function Create(X, Y: Integer): TPoint; inline; static;
    function Add(P: TPoint): TPoint;
  end;

  { TRectangle }

  TRectangle = record
  private
    function GetBottom: Integer;
    function GetLeft: Integer;
    function GetRight: Integer;
    function GetTop: Integer;
    procedure SetBottom(AValue: Integer);
    procedure SetLeft(AValue: Integer);
    procedure SetRight(AValue: Integer);
    procedure SetTop(AValue: Integer);
  public
    Position: TPoint;
    Size: TPoint;
    function PointInside(P: TPoint): Boolean;
    class function Create(Left, Top, Width, Height: Integer): TRectangle; overload; inline; static;
    class function Create(Position, Size: TPoint): TRectangle; overload; inline; static;
    function AddPoint(P: TPoint): TRectangle;
    property Left: Integer read GetLeft write SetLeft;
    property Top: Integer read GetTop write SetTop;
    property Right: Integer read GetRight write SetRight;
    property Bottom: Integer read GetBottom write SetBottom;
  end;

  TColorFormat = (cfRGBA8, cfGray8);
  TColor = Integer;

  { TCanvas }

  TCanvas = class
    Parent: TCanvas;
    Position: TPoint;
    Id: Integer;
    procedure DrawText(Pos: TPoint; Text: string; Color: TColor); virtual;
    procedure DrawLine(P1, P2: TPoint; Color: TColor); virtual;
    procedure DrawRect(Rect: TRectangle; Color: TColor); virtual;
    procedure DrawFrame(Rect: TRectangle; Color: TColor); virtual;
    procedure SetPixel(P: TPoint; Color: TColor); virtual;
  end;

  { TGraphicObject }

  TGraphicObject = class
  private
    FCanvas: TCanvas;
    function GetCanvas: TCanvas;
  public
    Desktop: TDesktop;
    Id: Integer;
    Visible: Boolean;
    constructor Create;
    procedure Paint; virtual;
    property Canvas: TCanvas read GetCanvas;
  end;

  { TWindow }

  TWindow = class(TGraphicObject)
  public
    Title: string;
    Bounds: TRectangle;
    procedure Paint; override;
    constructor Create;
    destructor Destroy; override;
  end;

  TRaster = class(TGraphicObject)
  end;

  TFont = class(TGraphicObject)
  end;

  { TDesktop }

  TDesktop = class
  private
    ObjectLastId: Integer;
    CanvasLastId: Integer;
  public
    Objects: TObjectList<TGraphicObject>;
    Canvases: TObjectList<TCanvas>;
    ParentCanvas: TCanvas;
    function CreateWindow: TWindow;
    function CreateCanvas: TCanvas;
    function FindObjectById(Id: Integer): TGraphicObject;
    function FindCanvasById(Id: Integer): TCanvas;
    procedure Paint;
    constructor Create;
    destructor Destroy; override;
  end;


implementation

{ TRectangle }

function TRectangle.GetBottom: Integer;
begin
  Result := Position.Y + Size.Y;
end;

function TRectangle.GetLeft: Integer;
begin
  Result := Position.X;
end;

function TRectangle.GetRight: Integer;
begin
  Result := Position.X + Size.X;
end;

function TRectangle.GetTop: Integer;
begin
  Result := Position.Y;
end;

procedure TRectangle.SetBottom(AValue: Integer);
begin
  Size.Y := AValue - Position.Y;
end;

procedure TRectangle.SetLeft(AValue: Integer);
begin
  Position.X := AValue;
end;

procedure TRectangle.SetRight(AValue: Integer);
begin
  Size.X := AValue - Position.X;
end;

procedure TRectangle.SetTop(AValue: Integer);
begin
  Size.Y := AValue;
end;

function TRectangle.PointInside(P: TPoint): Boolean;
begin
  Result := (P.X >= Position.X) and (P.Y >= Position.Y) and
    (P.X < (Position.X + Size.X)) and (P.Y < (Position.Y + Size.Y))
end;

class function TRectangle.Create(Left, Top, Width, Height: Integer): TRectangle;
begin
  Result.Position.X := Left;
  Result.Position.Y := Top;
  Result.Size.X := Width;
  Result.Size.Y := Height;
end;

class function TRectangle.Create(Position, Size: TPoint): TRectangle;
begin
  Result.Position := Position;
  Result.Size := Size;
end;

function TRectangle.AddPoint(P: TPoint): TRectangle;
begin
  Result.Size := Size;
  Result.Position := Position.Add(P);
end;

{ TPoint }

class function TPoint.Create(X, Y: Integer): TPoint;
begin
  Result.X := X;
  Result.Y := Y;
end;

function TPoint.Add(P: TPoint): TPoint;
begin
  Result.X := X + P.X;
  Result.Y := Y + P.Y;
end;

{ TCanvas }

procedure TCanvas.DrawText(Pos: TPoint; Text: string; Color: TColor);
begin
  if Assigned(Parent) then
    Parent.DrawText(Pos.Add(Position), Text, Color);
end;

procedure TCanvas.DrawLine(P1, P2: TPoint; Color: TColor);
begin
  if Assigned(Parent) then
    Parent.DrawLine(P1.Add(Position), P2.Add(Position), Color);
end;

procedure TCanvas.DrawRect(Rect: TRectangle; Color: TColor);
begin
  if Assigned(Parent) then
    Parent.DrawRect(Rect.AddPoint(Position), Color);
end;

procedure TCanvas.DrawFrame(Rect: TRectangle; Color: TColor);
begin
  if Assigned(Parent) then
    Parent.DrawFrame(Rect.AddPoint(Position), Color);
end;

procedure TCanvas.SetPixel(P: TPoint; Color: TColor);
begin
  if Assigned(Parent) then
    Parent.SetPixel(P.Add(Position), Color);
end;

{ TGraphicObject }

function TGraphicObject.GetCanvas: TCanvas;
begin
  if not Assigned(FCanvas) then
    FCanvas := Desktop.CreateCanvas;
  Result := FCanvas;
end;

constructor TGraphicObject.Create;
begin
  FCanvas := nil;
end;

procedure TGraphicObject.Paint;
begin
end;

{ TWindow }

procedure TWindow.Paint;
begin
  inherited Paint;
  Canvas.DrawRect(TRectangle.Create(TPoint.Create(0, 0), Bounds.Size), $a0a0a0);
  Canvas.DrawFrame(TRectangle.Create(TPoint.Create(0, 0), Bounds.Size), $000000);
end;

constructor TWindow.Create;
begin
end;

destructor TWindow.Destroy;
begin
  inherited;
end;

{ TDesktop }

function TDesktop.CreateWindow: TWindow;
begin
  Inc(ObjectLastId);
  Result := TWindow.Create;
  Result.Id := ObjectLastId;
  Result.Desktop := Self;
  Result.Canvas.Parent := ParentCanvas;
  Objects.Add(Result);
  Paint;
end;

function TDesktop.CreateCanvas: TCanvas;
begin
  Inc(CanvasLastId);
  Result := TCanvas.Create;
  Result.Id := CanvasLastId;
  Canvases.Add(Result);
end;

function TDesktop.FindObjectById(Id: Integer): TGraphicObject;
var
  I: Integer;
begin
  I := 0;
  while (I < Objects.Count) and (Objects[I].Id <> Id) do Inc(I);
  if I < Objects.Count then Result := Objects[I]
    else Result := nil;
end;

function TDesktop.FindCanvasById(Id: Integer): TCanvas;
var
  I: Integer;
begin
  I := 0;
  while (I < Canvases.Count) and (Canvases[I].Id <> Id) do Inc(I);
  if I < Canvases.Count then Result := Canvases[I]
    else Result := nil;
end;

procedure TDesktop.Paint;
var
  I: Integer;
begin
  for I := 0 to Objects.Count - 1 do
    TGraphicObject(Objects[I]).Paint;
end;

constructor TDesktop.Create;
begin
  Objects := TObjectList<TGraphicObject>.Create;
  Canvases := TObjectList<TCanvas>.Create;
end;

destructor TDesktop.Destroy;
begin
  FreeAndNil(Canvases);
  FreeAndNil(Objects);
  inherited;
end;

end.