Changeset 4 for trunk


Ignore:
Timestamp:
Nov 23, 2014, 12:56:33 AM (10 years ago)
Author:
chronos
Message:
  • Added: Now applications can write text to serial device which is displayed on form.
Location:
trunk
Files:
3 added
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/Apps/UClock.pas

    r3 r4  
    66
    77uses
    8   Classes, SysUtils, UAPI, dateutils;
     8  Classes, SysUtils, UApp, dateutils;
    99
    1010type
    … …  
    2323procedure TAppClock.Run;
    2424begin
    25   while True do begin
     25  while not Terminated do begin
    2626    API.WriteText('test');
    2727    API.Sleep(OneSecond);

  • trunk/ChronOS.lpi

    r3 r4  
    3333      </Item1>
    3434    </RequiredPackages>
    35     <Units Count="9">
     35    <Units Count="12">
    3636      <Unit0>
    3737        <Filename Value="ChronOS.lpr"/>
    … …  
    8181        <UnitName Value="UList"/>
    8282      </Unit8>
     83      <Unit9>
     84        <Filename Value="UApp.pas"/>
     85        <IsPartOfProject Value="True"/>
     86        <UnitName Value="UApp"/>
     87      </Unit9>
     88      <Unit10>
     89        <Filename Value="UThreadEx.pas"/>
     90        <IsPartOfProject Value="True"/>
     91        <UnitName Value="UThreadEx"/>
     92      </Unit10>
     93      <Unit11>
     94        <Filename Value="UMemory.pas"/>
     95        <IsPartOfProject Value="True"/>
     96        <UnitName Value="UMemory"/>
     97      </Unit11>
    8398    </Units>
    8499  </ProjectOptions>

  • trunk/ChronOS.lpr

    r3 r4  
    1111  Interfaces, // this includes the LCL widgetset
    1212  Forms, UFormMain, UKernel, UFileSystem, UClock, UMemoryManager, UAPI,
    13   UPlatformBase, UList;
     13  UPlatformBase, UList, UApp, UThreadEx, UMemory;
    1414
    1515{$R *.res}

  • trunk/Platform/Base/UPlatformBase.pas

    r3 r4  
    66
    77uses
    8   Classes, SysUtils, UFileSystem, UKernel;
     8  Classes, SysUtils, UFileSystem, UKernel, syncobjs, UThreadEx, UMemory;
    99
    1010type
    1111  { TCustomThread }
    1212
    13   TCustomThread = class(TThread)
     13  TCustomThread = class(TThreadEx)
    1414    Task: TTask;
    1515    procedure Execute; override;
    … …  
    3232
    3333  TBaseScheduler = class(TScheduler)
    34     function AddTask(Name: string; EntryPoint: TEvent): TTask; override;
     34    function AddTask(Name: string; EntryPoint: TBasicEvent): TTask; override;
    3535    constructor Create; override;
     36    destructor Destroy; override;
    3637    procedure Start; override;
     38    procedure Stop; override;
     39  end;
     40
     41  TReceiveEvent = procedure(Data: TMemory) of object;
     42
     43  { TBaseSerialDevice }
     44
     45  TBaseSerialDevice = class(TDevice)
     46  private
     47    Lock: TCriticalSection;
     48    FOnReceiveData: TReceiveEvent;
     49  public
     50    constructor Create; override;
     51    destructor Destroy; override;
     52    procedure Service(Index: Integer; DataIn, DataOut: TMemory); override;
     53    property OnReceiveData: TReceiveEvent read FOnReceiveData write FOnReceiveData;
    3754  end;
    3855
    3956implementation
     57
     58{ TBaseSerialDevice }
     59
     60constructor TBaseSerialDevice.Create;
     61begin
     62  inherited Create;
     63  ClassName := 'Serial';
     64  Lock := TCriticalSection.Create;
     65end;
     66
     67destructor TBaseSerialDevice.Destroy;
     68begin
     69  Lock.Free;
     70  inherited Destroy;
     71end;
     72
     73procedure TBaseSerialDevice.Service(Index: Integer; DataIn, DataOut: TMemory);
     74begin
     75  inherited Service(Index, DataIn, DataOut);
     76  if Index = 0 then begin
     77    Lock.Acquire;
     78    if Assigned(FOnReceiveData) then
     79      FOnReceiveData(DataIn);
     80    Lock.Release;
     81  end else raise Exception.Create('Unsupported service ' + IntToStr(Index) + ' for driver ''' + Name + '''');
     82end;
    4083
    4184{ TBaseTask }
    … …  
    63106{ TBaseScheduler }
    64107
    65 function TBaseScheduler.AddTask(Name: string; EntryPoint: TEvent): TTask;
     108function TBaseScheduler.AddTask(Name: string; EntryPoint: TBasicEvent): TTask;
    66109var
    67110  Task: TBaseTask;
    … …  
    77120end;
    78121
     122destructor TBaseScheduler.Destroy;
     123begin
     124  inherited Destroy;
     125end;
     126
    79127procedure TBaseScheduler.Start;
    80128var
    … …  
    86134end;
    87135
     136procedure TBaseScheduler.Stop;
     137begin
     138  inherited Start;
     139end;
     140
    88141end.
    89142

  • trunk/UAPI.pas

    r3 r4  
    66
    77uses
    8   Classes, SysUtils, UList;
     8  Classes, SysUtils, UList, UKernel, DateUtils, UMemory;
    99
    1010type
    … …  
    1313
    1414  TAPI = class
     15    Kernel: TKernel;
    1516    procedure WriteText(Text: string);
    1617    procedure Sleep(Time: TDateTime);
    1718  end;
    1819
    19   { TApp }
    20 
    21   TApp = class(TNamedObject)
    22     API: TAPI;
    23     constructor Create; virtual;
    24     destructor Destroy; override;
    25     procedure Run; virtual;
    26   end;
    2720
    2821implementation
    … …  
    3124
    3225procedure TAPI.WriteText(Text: string);
     26var
     27  Device: TDevice;
     28  DataIn: TMemory;
    3329begin
    34 
     30  Device := TDevice(Kernel.Devices.FindByName('Serial0'));
     31  if Assigned(Device) then begin
     32    DataIn := TMemory.Create;
     33    DataIn.Size := Length(Text);
     34    Move(Text[1], DataIn.Data^, DataIn.Size);
     35    Device.Service(0, DataIn, nil);
     36    DataIn.Free;
     37  end else raise Exception.Create('Device Serial0 not found');
    3538end;
    3639
    3740procedure TAPI.Sleep(Time: TDateTime);
    3841begin
    39 
     42  SysUtils.Sleep(Trunc(Time / OneMillisecond));
    4043end;
    4144
    42 { TApp }
    43 
    44 constructor TApp.Create;
    45 begin
    46   inherited Create;
    47   API := TAPI.Create;
    48 end;
    49 
    50 destructor TApp.Destroy;
    51 begin
    52   API.Free;
    53   inherited Destroy;
    54 end;
    55 
    56 procedure TApp.Run;
    57 begin
    58 
    59 end;
    6045
    6146end.

  • trunk/UFormMain.lfm

    r3 r4  
    55  Width = 932
    66  Caption = 'Form1'
     7  ClientHeight = 687
     8  ClientWidth = 932
    79  OnCreate = FormCreate
    810  OnDestroy = FormDestroy
    911  OnShow = FormShow
    1012  LCLVersion = '1.3'
     13  object Memo1: TMemo
     14    Left = 16
     15    Height = 658
     16    Top = 8
     17    Width = 904
     18    TabOrder = 0
     19  end
    1120end

  • trunk/UFormMain.pas

    r3 r4  
    66
    77uses
    8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, UKernel;
     8  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
     9  UKernel, UMemory;
    910
    1011type
    … …  
    1314
    1415  TForm1 = class(TForm)
     16    Memo1: TMemo;
    1517    procedure FormCreate(Sender: TObject);
    1618    procedure FormDestroy(Sender: TObject);
    1719    procedure FormShow(Sender: TObject);
    1820  private
    19     { private declarations }
     21    SerialText: string;
     22    procedure SerialDeviceReceiveDataSync;
     23    procedure SerialDeviceReceiveData(Data: TMemory);
    2024  public
    2125    Kernel: TKernel;
    … …  
    2832
    2933uses
    30   UList, UAPI, UClock, UPlatformBase;
     34  UList, UApp, UAPI, UClock, UPlatformBase, UThreadEx;
    3135
    3236{$R *.lfm}
    … …  
    3741var
    3842  NewApp: TApp;
     43  SerialDevice: TBaseSerialDevice;
    3944begin
    4045  Kernel := TKernel.Create;
    4146  Kernel.SchedulerClass := TBaseScheduler;
    4247  Kernel.FileSystemClass := TBaseFileSystem;
    43 
     48  SerialDevice := TBaseSerialDevice.Create;
     49  SerialDevice.Name := 'Serial0';
     50  SerialDevice.OnReceiveData := SerialDeviceReceiveData;
     51  Kernel.Devices.Add(SerialDevice);
    4452  NewApp := TAppClock.Create;
    4553  Kernel.Apps.Add(NewApp);
    … …  
    5664end;
    5765
     66procedure TForm1.SerialDeviceReceiveDataSync;
     67begin
     68  Memo1.Lines.AddText(SerialText);
     69end;
     70
     71procedure TForm1.SerialDeviceReceiveData(Data: TMemory);
     72begin
     73  SetLength(SerialText, Data.Size);
     74  Move(Data.Data^, SerialText[1], Data.Size);
     75  TThreadEx.Synchronize(TThreadEx.CurrentThread, SerialDeviceReceiveDataSync);
     76end;
     77
    5878end.
    5979

  • trunk/UKernel.pas

    r3 r4  
    66
    77uses
    8   Classes, SysUtils, UList, Contnrs, UFileSystem, UAPI;
     8  Classes, SysUtils, UList, Contnrs, UFileSystem, UMemory;
    99
    1010type
    11   TEvent = procedure of object;
     11  TBasicEvent = procedure of object;
    1212
    1313  TTaskState = (tsStopped, tsRunning, tsSuspended);
    … …  
    1818    Name: string;
    1919    State: TTaskState;
    20     EntryPoint: TEvent;
     20    EntryPoint: TBasicEvent;
    2121    constructor Create; virtual;
    2222  end;
    … …  
    3131    Running: Boolean;
    3232    procedure Start; virtual;
    33     procedure Stop;
    34     function AddTask(Name: string; EntryPoint: TEvent): TTask; virtual;
     33    procedure Stop; virtual;
     34    function AddTask(Name: string; EntryPoint: TBasicEvent): TTask; virtual;
    3535    constructor Create; virtual;
    3636    destructor Destroy; override;
    … …  
    4343  end;
    4444
     45  { TDevice }
     46
     47  TDevice = class(TNamedObject)
     48    ClassName: string;
     49    constructor Create; virtual;
     50    procedure Service(Index: Integer; DataIn, DataOut: TMemory); virtual;
     51  end;
     52
    4553  { TKernel }
    4654
    … …  
    5159    SchedulerClass: TSchedulerClass;
    5260    FileSystemClass: TFileSystemClass;
     61    Devices: TNamedObjectList; // TList<TDevice>
    5362    procedure AppExecute(AFile: TFile);
    5463    procedure Init;
    … …  
    5968
    6069implementation
     70
     71uses
     72  UApp;
     73
     74{ TDevice }
     75
     76constructor TDevice.Create;
     77begin
     78  inherited Create;
     79end;
     80
     81procedure TDevice.Service(Index: Integer; DataIn, DataOut: TMemory);
     82begin
     83
     84end;
    6185
    6286{ TTask }
    … …  
    79103end;
    80104
    81 function TScheduler.AddTask(Name: string; EntryPoint: TEvent): TTask;
     105function TScheduler.AddTask(Name: string; EntryPoint: TBasicEvent): TTask;
    82106var
    83107  NewTask: TTask;
    … …  
    111135  App := TApp(Apps.FindByName(AFile.Name));
    112136  if Assigned(App) then begin
     137    App.API.Kernel := Self;
    113138    Scheduler.AddTask(App.Name, App.Run);
    114139  end else raise Exception.Create('Application ''' + AFile.Name + ''' no found');
    … …  
    152177constructor TKernel.Create;
    153178begin
     179  Devices := TNamedObjectList.Create;
    154180  Drives := TNamedObjectList.Create;
    155181  Apps := TNamedObjectList.Create;
    … …  
    162188  Apps.Free;
    163189  Drives.Free;
     190  Devices.Free;
    164191  inherited Destroy;
    165192end;

  • trunk/UList.pas

    r2 r4  
    99
    1010type
     11
     12  { TNamedObject }
     13
    1114  TNamedObject = class
    1215    Name: string;
Note: See TracChangeset for help on using the changeset viewer.