Changeset 9 for trunk


Ignore:
Timestamp:
Aug 29, 2016, 5:17:45 PM (8 years ago)
Author:
chronos
Message:
  • Fixed: Removed duplicit files moved previously to Kernel package.
Location:
trunk
Files:
2 added
7 deleted
15 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        33lib
        44heaptrclog.trc
         5ChronOS.exe

  • trunk/Apps/UClock.pas

    r8 r9  
    66
    77uses
    8   Classes, SysUtils, UApp, dateutils, UKernel;
     8  Classes, SysUtils, UApp, dateutils, UKernel, UScheduler, UIPC;
    99
    1010type

  • trunk/ChronOS.lpi

    r8 r9  
    8686        <HasResources Value="True"/>
    8787        <ResourceBaseClass Value="Form"/>
    88         <UnitName Value="UFormMain"/>
    8988      </Unit1>
    9089      <Unit2>
    9190        <Filename Value="Apps/UClock.pas"/>
    9291        <IsPartOfProject Value="True"/>
    93         <UnitName Value="UClock"/>
    9492      </Unit2>
    9593      <Unit3>
    9694        <Filename Value="Apps/UMemoryManager.pas"/>
    9795        <IsPartOfProject Value="True"/>
    98         <UnitName Value="UMemoryManager"/>
    9996      </Unit3>
    10097      <Unit4>
    10198        <Filename Value="Platform/Base/UPlatformBase.pas"/>
    10299        <IsPartOfProject Value="True"/>
    103         <UnitName Value="UPlatformBase"/>
    104100      </Unit4>
    105101      <Unit5>
    106102        <Filename Value="UThreadEx.pas"/>
    107103        <IsPartOfProject Value="True"/>
    108         <UnitName Value="UThreadEx"/>
    109104      </Unit5>
    110105      <Unit6>
    … …  
    114109        <HasResources Value="True"/>
    115110        <ResourceBaseClass Value="Form"/>
    116         <UnitName Value="UFormTerminal"/>
    117111      </Unit6>
    118112    </Units>

  • trunk/Forms/UFormMain.lfm

    r8 r9  
    55  Width = 932
    66  Caption = 'Screen 1 - ChronOS'
    7   ClientHeight = 658
     7  ClientHeight = 662
    88  ClientWidth = 932
    99  Menu = MainMenu1
    … …  
    1212  OnKeyDown = FormKeyDown
    1313  OnShow = FormShow
    14   LCLVersion = '1.5'
     14  LCLVersion = '1.6.0.4'
    1515  object PaintBox1: TPaintBox
    1616    Left = 0
    17     Height = 658
     17    Height = 662
    1818    Top = 0
    1919    Width = 932

  • trunk/Forms/UFormMain.pas

    r8 r9  
    4646    procedure VideoDeviceRedrawSync;
    4747    procedure SwitchFullScreen;
    48     procedure EraseBackground(DC: HDC); override;
    4948  public
    5049    Kernel: TKernel;
     50    procedure EraseBackground(DC: HDC); override;
    5151  end;
    5252

  • trunk/Packages/Kernel

    • Property svn:ignore set to
      lib

  • trunk/Packages/Kernel/Kernel.lpk

    r8 r9  
    1919      </Parsing>
    2020    </CompilerOptions>
    21     <Files Count="10">
     21    <Files Count="12">
    2222      <Item1>
    2323        <Filename Value="UAPI.pas"/>
    … …  
    6060        <UnitName Value="UScreen"/>
    6161      </Item10>
     62      <Item11>
     63        <Filename Value="UIPC.pas"/>
     64        <UnitName Value="UIPC"/>
     65      </Item11>
     66      <Item12>
     67        <Filename Value="UScheduler.pas"/>
     68        <UnitName Value="UScheduler"/>
     69      </Item12>
    6270    </Files>
    6371    <RequiredPkgs Count="1">

  • trunk/Packages/Kernel/Kernel.pas

    r8 r9  
    99uses
    1010  UAPI, UApp, UClasses, UFileSystem, UGraphics, UKernel, UList, UMemory,
    11   UDevice, UScreen, LazarusPackageIntf;
     11  UDevice, UScreen, UIPC, UScheduler, LazarusPackageIntf;
    1212
    1313implementation

  • trunk/Packages/Kernel/UAPI.pas

    r8 r9  
    66
    77uses
    8   Classes, SysUtils, UList, UKernel, DateUtils, UMemory, UScreen, UDevice;
     8  Classes, SysUtils, UList, DateUtils, UMemory, UScreen, UDevice, UIPC,
     9  UScheduler;
    910
    1011type
    … …  
    1314
    1415  TAPI = class
    15     Kernel: TKernel;
     16    Kernel: TObject; //TKernel;
    1617    procedure WriteText(Text: string);
    1718    procedure DrawText(P: TPoint; Text: string; Color: TColor);
    … …  
    2728implementation
    2829
     30uses
     31  UKernel;
     32
    2933{ TAPI }
    3034
    … …  
    3337  Device: TDeviceSerial;
    3438begin
    35   Device := TDeviceSerial(Kernel.Devices.FindByName('Serial0'));
     39  Device := TDeviceSerial(TKernel(Kernel).Devices.FindByName('Serial0'));
    3640  if Assigned(Device) then begin
    3741    Device.WriteText(Text);
    … …  
    4347  Screen: TScreen;
    4448begin
    45   Screen := TScreen(Kernel.Screens.First);
     49  Screen := TScreen(TKernel(Kernel).Screens.First);
    4650  Screen.DrawText(P, Text, Color);
    4751end;
    … …  
    5155  Screen: TScreen;
    5256begin
    53   Screen := TScreen(Kernel.Screens.First);
     57  Screen := TScreen(TKernel(Kernel).Screens.First);
    5458  Screen.DrawLine(P1, P2, Color);
    5559end;
    … …  
    5963  Screen: TScreen;
    6064begin
    61   Screen := TScreen(Kernel.Screens.First);
     65  Screen := TScreen(TKernel(Kernel).Screens.First);
    6266  Screen.DrawRect(Rect, Color);
    6367end;
    … …  
    6771  Task: TTask;
    6872begin
    69   Task := Kernel.Scheduler.GetCurrentTask;
     73  Task := TKernel(Kernel).Scheduler.GetCurrentTask;
    7074  Task.Sleep(Time);
    7175end;
    … …  
    7579  Task: TTask;
    7680begin
    77   Task := Kernel.Scheduler.GetCurrentTask;
    78   while Task.Messages.Count = 0 do Task.WaitForMessage;
     81  Task := TKernel(Kernel).Scheduler.GetCurrentTask;
     82  while Task.Messages.List.Count = 0 do Task.WaitForMessage;
    7983end;
    8084

  • trunk/Packages/Kernel/UApp.pas

    r8 r9  
    66
    77uses
    8   Classes, SysUtils, UList, UAPI, UKernel;
     8  Classes, SysUtils, UList, UAPI, UScheduler;
    99
    1010type

  • trunk/Packages/Kernel/UFileSystem.pas

    r8 r9  
    2020
    2121  TDirectory = class(TFileSystemObject)
    22     Items: TNamedObjectList; // TList<TFileSystemObject>
     22    Items: TNamedObjectList<TFileSystemObject>;
    2323    constructor Create;
    2424    destructor Destroy; override;
    … …  
    5454constructor TDirectory.Create;
    5555begin
    56   Items := TNamedObjectList.Create;
     56  Items := TNamedObjectList<TFileSystemObject>.Create;
    5757end;
    5858

  • trunk/Packages/Kernel/UKernel.pas

    r8 r9  
    66
    77uses
    8   Classes, Math, SysUtils, UList, Contnrs, UFileSystem, UMemory, UScreen, UDevice;
     8  Classes, Math, SysUtils, UList, Contnrs, UFileSystem, UMemory, UScreen, UDevice,
     9  fgl, UApp, UScheduler;
    910
    1011type
    11   TTask = class;
    12   TScheduler = class;
    13 
    14   TTaskEvent = procedure(Task: TTask) of object;
    15 
    16   TTaskState = (tsStopped, tsRunning, tsSuspended, tsWaiting);
    17 
    18   TIPCMessage = class
    19     Name: string;
    20     Action: string;
    21 
    22   end;
    23 
    24   TWaitReason = (wrSleep, wrMessage);
    25 
    26   { TTask }
    27 
    28   TTask = class(TNamedObject)
    29     Scheduler: TScheduler;
    30     State: TTaskState;
    31     WaitReason: TWaitReason;
    32     WakeUpTime: TDateTime;
    33     Terminated: Boolean;
    34     EntryPoint: TTaskEvent;
    35     Messages: TObjectQueue; // TQueue<TIPMessage>
    36     procedure WaitForMessage;
    37     procedure Sleep(Duration: TDateTime);
    38     constructor Create; virtual;
    39     destructor Destroy; override;
    40   end;
    41 
    42   TTaskClass = class of TTask;
    43 
    44   { TScheduler }
    45 
    46   TScheduler = class
    47     TaskClass: TTaskClass;
    48     Tasks: TNamedObjectList; // TList<TTask>
    49     Running: Boolean;
    50     function GetCurrentTask: TTask; virtual;
    51     procedure Start; virtual;
    52     procedure Stop; virtual;
    53     function AddTask(Name: string; EntryPoint: TTaskEvent): TTask; virtual;
    54     procedure SwitchNext; virtual;
    55     constructor Create; virtual;
    56     destructor Destroy; override;
    57   end;
    58 
    59   TSchedulerClass = class of TScheduler;
    60 
    6112  { TDrive }
    6213
    … …  
    7728    procedure InitVideo;
    7829  public
    79     Apps: TNamedObjectList; // TList<TApp>
    80     Drives: TNamedObjectList; // TList<TDrive>
     30    Apps: TNamedObjectList<TApp>;
     31    Drives: TNamedObjectList<TDrive>;
    8132    Scheduler: TScheduler;
    8233    SchedulerClass: TSchedulerClass;
    8334    FileSystemClass: TFileSystemClass;
    84     Devices: TNamedObjectList; // TList<TDevice>
    85     Screens: TObjectList; // TList<TScreen>
     35    Devices: TNamedObjectList<TDevice>;
     36    Screens: TFPGObjectList<TScreen>;
    8637    procedure AppExecute(AFile: TFile);
    8738    procedure Init;
    … …  
    9243
    9344implementation
    94 
    95 uses
    96   UApp;
    9745
    9846
    … …  
    10755begin
    10856  FileSystem.Free;
    109   inherited Destroy;
    110 end;
    111 
    112 { TTask }
    113 
    114 procedure TTask.WaitForMessage;
    115 begin
    116   WaitReason := wrMessage;
    117   State := tsWaiting;
    118   Scheduler.SwitchNext;
    119 end;
    120 
    121 procedure TTask.Sleep(Duration: TDateTime);
    122 begin
    123   WakeUpTime := Now + Duration;
    124   State := tsWaiting;
    125   WaitReason := wrSleep;
    126   Scheduler.SwitchNext;
    127 end;
    128 
    129 constructor TTask.Create;
    130 begin
    131   Messages := TObjectQueue.Create;
    132 end;
    133 
    134 destructor TTask.Destroy;
    135 begin
    136   Messages.Free;
    137   inherited Destroy;
    138 end;
    139 
    140 { TScheduler }
    141 
    142 function TScheduler.GetCurrentTask: TTask;
    143 begin
    144   Result := nil;
    145 end;
    146 
    147 procedure TScheduler.Start;
    148 begin
    149   Running := True;
    150 end;
    151 
    152 procedure TScheduler.Stop;
    153 begin
    154   Running := False;
    155 end;
    156 
    157 function TScheduler.AddTask(Name: string; EntryPoint: TTaskEvent): TTask;
    158 var
    159   NewTask: TTask;
    160 begin
    161   NewTask := TaskClass.Create;
    162   NewTask.Scheduler := Self;
    163   NewTask.Name := Name;
    164   NewTask.EntryPoint := EntryPoint;
    165   Tasks.Add(NewTask);
    166   Result := NewTask;
    167 end;
    168 
    169 procedure TScheduler.SwitchNext;
    170 begin
    171 
    172 end;
    173 
    174 constructor TScheduler.Create;
    175 begin
    176   TaskClass := TTask;
    177   Tasks := TNamedObjectList.Create;
    178 end;
    179 
    180 destructor TScheduler.Destroy;
    181 begin
    182   if Running then Stop;
    183   Tasks.Free;
    18457  inherited Destroy;
    18558end;
    … …  
    264137constructor TKernel.Create;
    265138begin
    266   Devices := TNamedObjectList.Create;
    267   Drives := TNamedObjectList.Create;
    268   Apps := TNamedObjectList.Create;
     139  Devices := TNamedObjectList<TDevice>.Create;
     140  Drives := TNamedObjectList<TDrive>.Create;
     141  Apps := TNamedObjectList<TApp>.Create;
    269142  Scheduler := TScheduler.Create;
    270   Screens := TObjectList.Create;
     143  Screens := TFPGObjectList<TScreen>.Create;
    271144end;
    272145

  • trunk/Packages/Kernel/UList.pas

    r8 r9  
    66
    77uses
    8   Classes, SysUtils, Contnrs;
     8  Classes, SysUtils, Contnrs, fgl;
    99
    1010type
    … …  
    1818  { TNamedObjectList }
    1919
    20   TNamedObjectList = class(TObjectList)
    21     function FindByName(Name: string): TNamedObject;
     20  TNamedObjectList<T> = class(TFPGObjectList<T>)
     21    function FindByName(Name: string): T;
    2222  end;
    2323
    … …  
    2727{ TNamedObjectList }
    2828
    29 function TNamedObjectList.FindByName(Name: string): TNamedObject;
     29function TNamedObjectList<T>.FindByName(Name: string): T;
    3030var
    3131  I: Integer;
    … …  
    3333  I := 0;
    3434  while (I < Count) and (TNamedObject(Items[I]).Name <> Name) do Inc(I);
    35   if I < Count then Result := TNamedObject(Items[I])
     35  if I < Count then Result := Items[I]
    3636    else Result := nil;
    3737end;

  • trunk/Platform/Base/UPlatformBase.pas

    r8 r9  
    77uses
    88  Classes, SysUtils, UFileSystem, UKernel, syncobjs, UThreadEx, UMemory,
    9   DateUtils, UDevice, Contnrs, Graphics, Forms, UScreen;
     9  DateUtils, UDevice, Contnrs, Graphics, Forms, UScreen, UScheduler;
    1010
    1111type
    … …  
    6363    FOnModeChanged: TNotifyEvent;
    6464    FOnRedraw: TNotifyEvent;
    65     OnModeChanged: TNotifyEvent;
    6665    procedure DoRedraw;
    6766  public
Note: See TracChangeset for help on using the changeset viewer.