source: branches/textos/UKernel.pas

unit UKernel;

{$mode delphi}

interface

uses
  Classes, SysUtils, Forms, Generics.Collections, UApp, UApi, UTextBuffer;

type
  TKernel = class;
  TAppContext = class;

  { TKernelApi }

  TKernelApi = class(TApi)
    Kernel: TKernel;
    AppContext: TAppContext;
    procedure Sleep(Time: TDateTime); override;
    function GetMessage: TApiMessage; override;
    function InputText: string; override;
    procedure OutputText(Text: string); override;
    procedure Terminate; override;
    procedure ExecuteApp(Name: string); override;
  end;

  { TAppThread }

  TAppThread = class(TThread)
    AppContext: TAppContext;
    procedure Execute; override;
  end;

  TAppState = (asSleep, asRunning, asTerminated);

  { TAppContext }

  TAppContext = class
    AppState: TAppState;
    App: TApp;
    AppDescription: TAppDescription;
    InputBuffer: TTextBuffer;
    OutputBuffer: TTextBuffer;
    Messages: TList<TApiMessage>;
    Thread: TAppThread;
    procedure Start;
    procedure Stop;
    constructor Create;
    destructor Destroy; override;
  end;

  TOutputTextEvent = procedure (Text: string) of object;

  { TKernel }

  TKernel = class
  private
    FOnOutputText: TOutputTextEvent;
    FAppContexts: TObjectList<TAppContext>;
    FCurrentApp: TAppContext;
    FAppDescriptions: TAppDescriptions;
    procedure Schedule;
    function AddAppContext(AppDescription: TAppDescription): TAppContext;
    procedure DoOutputText(Text: string);
    procedure RemoveTerminated;
  public
    Terminated: Boolean;
    function AddApp(Name: string; AppClass: TAppClass): TAppDescription;
    procedure Start;
    procedure Input(Text: string);
    procedure InputKey(Key: Word);
    constructor Create;
    destructor Destroy; override;
    property OnOutputText: TOutputTextEvent read FOnOutputText write FOnOutputText;
  end;


implementation

{ TAppThread }

procedure TAppThread.Execute;
begin
  while not Terminated do begin
    AppContext.App.Run;
  end;
  AppContext.AppState := asTerminated;
end;

{ TAppContext }

procedure TAppContext.Start;
begin
  Thread.Resume;
end;

procedure TAppContext.Stop;
begin
  Thread.Terminate;
end;

constructor TAppContext.Create;
begin
  InputBuffer := TTextBuffer.Create;
  OutputBuffer := TTextBuffer.Create;
  Messages := TList<TApiMessage>.Create;
  Thread := TAppThread.Create(True);
  Thread.AppContext := Self;
end;

destructor TAppContext.Destroy;
begin
  FreeAndNil(Thread);
  FreeAndNil(Messages);
  FreeAndNil(InputBuffer);
  FreeAndNil(OutputBuffer);
  inherited;
end;

{ TKernelApi }

procedure TKernelApi.Sleep(Time: TDateTime);
begin

end;

function TKernelApi.GetMessage: TApiMessage;
begin
  while AppContext.AppState <> asTerminated do begin
    if AppContext.AppState = asTerminated then begin
      Result := amTerminate;
      Break;
    end else begin
      if AppContext.InputBuffer.Size > 0 then begin
        Result := amInputText;
        Break;
      end;
    end;
    Sleep(1);
  end;
end;

function TKernelApi.InputText: string;
begin
  Result := AppContext.InputBuffer.Read;
end;

procedure TKernelApi.OutputText(Text: string);
begin
  AppContext.OutputBuffer.Write(Text);
end;

procedure TKernelApi.Terminate;
begin
  AppContext.AppState := asTerminated;
  AppContext.Thread.Terminate;
end;

procedure TKernelApi.ExecuteApp(Name: string);
var
  AppDescription: TAppDescription;
  AppContext: TAppContext;
begin
  AppDescription := Kernel.FAppDescriptions.SearchByName(Name);
  if Assigned(AppDescription) then begin
    AppContext := Kernel.AddAppContext(AppDescription);
    AppContext.Start;
    Kernel.FCurrentApp := Kernel.FAppContexts[Kernel.FAppContexts.Count - 1];
  end;
end;

{ TKernel }

procedure TKernel.Schedule;
var
  I: Integer;
begin
  I := FAppContexts.IndexOf(FCurrentApp);
  if FAppContexts.Count > 0 then begin
    I := (I + 1) mod FAppContexts.Count;
    FCurrentApp := FAppContexts[I];
  end else FCurrentApp := nil;
end;

function TKernel.AddAppContext(AppDescription: TAppDescription): TAppContext;
var
  App: TApp;
begin
  App := AppDescription.AppClass.Create;
  Result := TAppContext.Create;
  Result.App := App;
  Result.AppDescription := AppDescription;
  App.Api.Parent := TKernelApi.Create;
  TKernelApi(App.Api.Parent).AppContext := Result;
  TKernelApi(App.Api.Parent).Kernel := Self;
  FAppContexts.Add(Result);
end;

procedure TKernel.DoOutputText(Text: string);
begin
  if Assigned(FOnOutputText) then FOnOutputText(Text);
end;

procedure TKernel.RemoveTerminated;
var
  I: Integer;
begin
  for I := FAppContexts.Count - 1 downto 0 do begin
    if FAppContexts[I].AppState = asTerminated then begin
      FAppContexts.Delete(I);
      if FAppContexts.Count > 0 then
        FCurrentApp := FAppContexts[I mod FAppContexts.Count]
        else FCurrentApp := nil;
    end;
  end;
  if FAppContexts.Count = 0 then Terminated := True;
end;

function TKernel.AddApp(Name: string; AppClass: TAppClass): TAppDescription;
begin
  Result := TAppDescription.Create;
  Result.Name := Name;
  Result.AppClass := AppClass;
  FAppDescriptions.Add(Result);
end;

procedure TKernel.Start;
var
  Text: string;
begin
  if FAppDescriptions.Count > 0 then begin
    FCurrentApp := AddAppContext(FAppDescriptions[0]);
    FCurrentApp.Start;
    repeat
      RemoveTerminated;
      Application.ProcessMessages;
      Sleep(1);

      if Assigned(FCurrentApp) then begin
        Text := FCurrentApp.OutputBuffer.Read;
        if Text <> '' then begin
          DoOutputText(Text);
        end;
      end;
    until Terminated;
  end;
end;

procedure TKernel.Input(Text: string);
begin
  if Assigned(FCurrentApp) then begin
    FCurrentApp.InputBuffer.Write(Text);
  end;
end;

procedure TKernel.InputKey(Key: Word);
begin
  if Key = 9 then begin
    if FAppContexts.Count > 1 then begin
      FCurrentApp := FAppContexts[(FAppContexts.IndexOf(FCurrentApp) + 1 ) mod FAppContexts.Count];
      DoOutputText('Switched to ' + FCurrentApp.AppDescription.Name + LineEnding);
    end;
  end;
end;

constructor TKernel.Create;
begin
  FAppContexts := TObjectList<TAppContext>.Create;
  FAppDescriptions := TAppDescriptions.Create;
end;

destructor TKernel.Destroy;
begin
  FreeAndNil(FAppContexts);
  FreeAndNil(FAppDescriptions);
  inherited;
end;

end.