source: branches/Xvcl/Xvcl.Kernel.pas

unit Xvcl.Kernel;

interface

uses
  Xvcl.Generics, Xvcl.Classes, Xvcl.Forms, Xvcl.Controls, Xvcl.Graphics;

type
  TKernel = class;
  TScreen = class;

  TProcessState = (psReady, psRunning, psWaiting, psFinished);

  TProcess = class
    Id: Integer;
    Name: string;
    Priority: Integer;
    State: TProcessState;
    procedure Execute; virtual;
  end;

  TDriver = class
    Name: string;
    Kernel: TKernel;
    procedure Initialize; virtual;
    procedure Finalize; virtual;
  end;

  TScreenCanvas = class(TCanvas)
    Screen: TScreen;
    function GetVideoDevice: TVideoDevice; override;
  end;

  TScreen = class(TComponent)
    Canvas: TScreenCanvas;
    Size: TPoint;
    Forms: TList<TForm>;
    VideoDevice: TVideoDevice;
    procedure Paint;
    procedure FocusForm(Form: TForm);
    constructor Create; override;
    destructor Destroy; override;
  end;

  TKeyboard = class
    Kernel: TKernel;
    KeysState: array[Word] of Boolean;
    function ReadKey: Char;
    function KeyPressed: Boolean;
  end;

  TMouse = class
    Kernel: TKernel;
    procedure HandleMove(Position: TPoint);
    procedure HandleDown(Position: TPoint);
    procedure HandleUp(Position: TPoint);
  end;

  TScheduler = class
    Kernel: TKernel;
    procedure Reschedule;
  end;

  TKernel = class
  private
    FOnAfterDriverInit: TNotifyEvent;
    FOnTick: TNotifyEvent;
  public
    Processes: TList<TProcess>;
    Drivers: TList<TDriver>;
    StartOnBoot: TList<TApplication>;
    Screen: TScreen;
    Keyboard: TKeyboard;
    Mouse: TMouse;
    Scheduler: TScheduler;
    Terminated: Boolean;
    procedure Boot;
    procedure PowerOff;
    procedure Reboot;
    constructor Create;
    destructor Destroy; override;
    property OnAfterDriverInit: TNotifyEvent read FOnAfterDriverInit
      write FOnAfterDriverInit;
    property OnTick: TNotifyEvent read FOnTick write FOnTick;
  end;


implementation

{ TKernel }

procedure TKernel.Boot;
var
  Driver: TDriver;
  App: TApplication;
begin
  for Driver in Drivers do
    Driver.Initialize;

  for App in StartOnBoot do
    App.Run;

  repeat
    Scheduler.Reschedule;
    if Assigned(FOnTick) then FOnTick(Self);
  until Terminated;

  for Driver in Drivers do
    Driver.Finalize;
end;

constructor TKernel.Create;
begin
  Processes := TList<TProcess>.Create;
  Drivers := TList<TDriver>.Create;
  Screen := TScreen.Create;
  StartOnBoot := TList<TApplication>.Create;
  Scheduler := TScheduler.Create;
  Keyboard := TKeyboard.Create;
  Keyboard.Kernel := Self;
  Mouse := TMouse.Create;
  Mouse.Kernel := Self;
end;

destructor TKernel.Destroy;
begin
  Mouse.Destroy;
  Keyboard.Destroy;
  Scheduler.Destroy;
  StartOnBoot.Destroy;
  Screen.Destroy;
  Drivers.Destroy;
  Processes.Destroy;
  inherited;
end;


procedure TKernel.PowerOff;
begin

end;

procedure TKernel.Reboot;
begin

end;

{ TScreen }

constructor TScreen.Create;
begin
  inherited;
  Forms := TList<TForm>.Create;
  Canvas := TScreenCanvas.Create;
  Canvas.Screen := Self;
end;

destructor TScreen.Destroy;
begin
  Canvas.Destroy;
  Forms.Destroy;
  inherited;
end;

procedure TScreen.FocusForm(Form: TForm);
var
  I: Integer;
  FormIndex: Integer;
begin
  FormIndex := Forms.IndexOf(Form);
  for I := 0 to Forms.Count - 1 do
    Forms[I].Focused := I = FormIndex;

  Forms.Move(FormsIndex, Forms.Count - 1);
  Paint;
end;

procedure TScreen.Paint;
var
  Form: TForm;
begin
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(TRectangle.Create(0, 0, Size.X, Size.Y));
  for Form in Forms do Form.Paint;
end;

{ TDriver }

procedure TDriver.Finalize;
begin

end;

procedure TDriver.Initialize;
begin

end;

{ TScheduler }

procedure TScheduler.Reschedule;
begin

end;

{ TKeyboard }

function TKeyboard.KeyPressed: Boolean;
begin
end;

function TKeyboard.ReadKey: Char;
begin

end;

{ TProcess }

procedure TProcess.Execute;
begin

end;

{ TMouse }

procedure TMouse.HandleDown(Position: TPoint);
var
  Form: TForm;
  NewMessage: TMessageMouseDown;
begin
  NewMessage := TMessageMouseDown.Create;
  NewMessage.Position := Position;
  try
    for Form in Kernel.Screen.Forms do
    if Form.Bounds.Contains(Position) then begin
      if Form.HandleMessage(NewMessage) then begin
        Break;
      end;
    end;
  finally
    NewMessage.Destroy;
  end;
end;

procedure TMouse.HandleMove(Position: TPoint);
var
  Form: TForm;
  NewMessage: TMessageMouseMove;
begin
  NewMessage := TMessageMouseMove.Create;
  NewMessage.Position := Position;
  try
    for Form in Kernel.Screen.Forms do
    if Form.Bounds.Contains(Position) then begin
      if Form.HandleMessage(NewMessage) then begin
        Break;
      end;
    end;
  finally
    NewMessage.Destroy;
  end;
end;

procedure TMouse.HandleUp(Position: TPoint);
var
  Form: TForm;
  NewMessage: TMessageMouseUp;
begin
  NewMessage := TMessageMouseUp.Create;
  NewMessage.Position := Position;
  try
    for Form in Kernel.Screen.Forms do
    if Form.Bounds.Contains(Position) then begin
      if Form.HandleMessage(NewMessage) then begin
        Break;
      end;
    end;
  finally
    NewMessage.Destroy;
  end;
end;

{ TScrenCanvas }

function TScreenCanvas.GetVideoDevice: TVideoDevice;
begin
  if Assigned(Screen) then Result := Screen.VideoDevice
    else Result := nil;
end;

end.