source: trunk/Platform/Base/PlatformBase.pas

unit PlatformBase;

interface

uses
  Classes, SysUtils, Kernel.FileSystem, Kernel.Core, syncobjs, ThreadEx,
  Kernel.Memory, DateUtils, Kernel.Device, Generics.Collections, Graphics, Forms,
  Kernel.Screen, Kernel.Scheduler, Kernel.Graphics;

type
  { TCustomThread }

  TCustomThread = class(TThreadEx)
    Task: TTask;
    procedure Execute; override;
  end;

  { TBaseTask }

  TBaseTask = class(TTask)
    Thread: TCustomThread;
    constructor Create; override;
    destructor Destroy; override;
  end;


  TBaseFileSystem = class(TFileSystem)

  end;

  { TBaseScheduler }

  TBaseScheduler = class(TScheduler)
    procedure SwitchNext; override;
    function GetCurrentTask: TTask; override;
    function AddTask(Name: string; EntryPoint: TTaskEvent): TTask; override;
    constructor Create; override;
    destructor Destroy; override;
    procedure Start; override;
    procedure Stop; override;
  end;

  TReceiveEvent = procedure(Text: string) of object;

  { TBaseSerialDevice }

  TBaseSerialDevice = class(TDeviceSerial)
  private
    Lock: TCriticalSection;
    FOnReceiveData: TReceiveEvent;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure WriteText(Text: string); override;
    property OnReceiveData: TReceiveEvent read FOnReceiveData write FOnReceiveData;
  end;

  { TDeviceVideoBase }

  TDeviceVideoBase = class(TDeviceVideo)
  private
    FOnModeChanged: TNotifyEvent;
    FOnRedraw: TNotifyEvent;
    procedure DoRedraw;
  protected
    procedure SetVideoMode(Mode: TVideoMode); override;
    function GetVideoMemory: PByte; override;
  public
    VideoMemory: PByte;
    DPI: Integer;
    Canvas: TCanvas;
    procedure GetSupportedModes(Modes: TVideoModes); override;
    procedure VideoMemoryChange; override;
    constructor Create; override;
    destructor Destroy; override;
    property OnRedraw: TNotifyEvent read FOnRedraw write FOnRedraw;
    property OnModeChanged: TNotifyEvent read FOnModeChanged write FOnModeChanged;
  end;

implementation

{ TDeviceVideoBase }

procedure TDeviceVideoBase.DoRedraw;
begin

end;

procedure TDeviceVideoBase.SetVideoMode(Mode: TVideoMode);
begin
  if (VideoMode.Size.X <> Mode.Size.X) or
    (VideoMode.Size.Y <> Mode.Size.Y) or
    (VideoMode.ColorFormat <> Mode.ColorFormat) then begin
      Lock.Acquire;
      try
        if Mode.GetBytesPerImage <> VideoMode.GetBytesPerImage then begin
          ReAllocMem(VideoMemory, Mode.GetBytesPerImage);
          FillDWord(VideoMemory^, Mode.GetBytesPerImage div 4, $ffffff);
        end;
        VideoMode.Size := Mode.Size;
        VideoMode.ColorFormat := Mode.ColorFormat;
      finally
        Lock.Release;
      end;
      if Assigned(FOnModeChanged) then
        FOnModeChanged(Self);
    end;
end;

procedure TDeviceVideoBase.GetSupportedModes(Modes: TVideoModes);
var
  NewMode: TVideoMode;
begin
  Modes.Clear;
  NewMode := TVideoMode.Create;
  NewMode.Size := TPoint.Create(320, 240);
  NewMode.ColorFormat := cfRGBA8;
  Modes.Add(NewMode);
  NewMode := TVideoMode.Create;
  NewMode.Size := TPoint.Create(640, 480);
  NewMode.ColorFormat := cfRGBA8;
  Modes.Add(NewMode);
{  NewMode := TVideoMode.Create;
  NewMode.Size := Point(800, 600);
  NewMode.ColorFormat := cfRGBA8;
  Modes.Add(NewMode);
  NewMode := TVideoMode.Create;
  NewMode.Size := Point(1024, 768);
  NewMode.ColorFormat := cfRGBA8;
  Modes.Add(NewMode);
  NewMode := TVideoMode.Create;
  NewMode.Size := Point(1278, 1024);
  NewMode.ColorFormat := cfRGBA8;
  Modes.Add(NewMode);
  NewMode := TVideoMode.Create;
  NewMode.Size := Point(1920, 1080);
  NewMode.ColorFormat := cfRGBA8;
  Modes.Add(NewMode);
  }
end;

function TDeviceVideoBase.GetVideoMemory: PByte;
begin
  Result := VideoMemory;
end;

procedure TDeviceVideoBase.VideoMemoryChange;
begin
  if Assigned(FOnRedraw) then FOnRedraw(Self);
end;

constructor TDeviceVideoBase.Create;
begin
  inherited Create;
end;

destructor TDeviceVideoBase.Destroy;
begin
  inherited;
end;

{ TBaseSerialDevice }

constructor TBaseSerialDevice.Create;
begin
  inherited Create;
  ClassName := 'Serial';
  Lock := TCriticalSection.Create;
end;

destructor TBaseSerialDevice.Destroy;
begin
  FreeAndNil(Lock);
  inherited;
end;

procedure TBaseSerialDevice.WriteText(Text: string);
begin
  Lock.Acquire;
  if Assigned(FOnReceiveData) then
    FOnReceiveData(Text);
  Lock.Release;
end;

{ TBaseTask }

constructor TBaseTask.Create;
begin
  inherited;
  Thread := TCustomThread.Create(True);
  Thread.Task := Self;
end;

destructor TBaseTask.Destroy;
begin
  FreeAndNil(Thread);
  inherited;
end;

{ TCustomThread }

procedure TCustomThread.Execute;
begin
  Task.EntryPoint(Task);
end;

{ TBaseScheduler }

procedure TBaseScheduler.SwitchNext;
var
  Task: TTask;
  Duration: TDateTime;
begin
  Task := GetCurrentTask;
  if Task.State = tsWaiting then begin
    if Task.WaitReason = wrSleep then begin
      Duration := (Task.WakeUpTime - Now) / OneMillisecond;
      if Duration > 0 then SysUtils.Sleep(Trunc(Duration));
    end;
  end;
end;

function TBaseScheduler.GetCurrentTask: TTask;
var
  I: Integer;
begin
  I := 0;
  while (I < Tasks.Count) and (TBaseTask(Tasks[I]).Thread.ThreadID <> ThreadID) do
    Inc(I);
  if I < Tasks.Count then Result := TBaseTask(Tasks[I])
    else Result := nil;
end;

function TBaseScheduler.AddTask(Name: string; EntryPoint: TTaskEvent): TTask;
var
  Task: TBaseTask;
begin
  Task := TBaseTask(inherited AddTask(Name, EntryPoint));
  if Running then Task.Thread.Start;
  Result := Task;
end;

constructor TBaseScheduler.Create;
begin
  inherited;
  TaskClass := TBaseTask;
end;

destructor TBaseScheduler.Destroy;
begin
  inherited;
end;

procedure TBaseScheduler.Start;
var
  I: Integer;
begin
  inherited Start;
  for I := 0 to Tasks.Count - 1 do
    TBaseTask(Tasks[I]).Thread.Start;
end;

procedure TBaseScheduler.Stop;
var
  I: Integer;
begin
  inherited Stop;
  for I := 0 to Tasks.Count - 1 do begin
    TBaseTask(Tasks[I]).Terminated := True;
    TBaseTask(Tasks[I]).Thread.WaitFor;
  end;
end;

end.