Changeset 8


Ignore:
Timestamp:
May 9, 2015, 1:32:38 AM (9 years ago)
Author:
chronos
Message:
  • Moved: Kernel related files moved to separate lazarus package named Kernel.
  • Modified: Implemented simple graphic device driver and drawin example.
Location:
trunk
Files:
14 added
7 edited

Legend:

Unmodified
Added
Removed

  • trunk/Apps/UClock.pas

    r7 r8  
    2525  Message: TIPCMessage;
    2626  WindowId: Integer;
     27  Angle: Double;
    2728begin
    2829  Message := TIPCMessage.Create;
    … …  
    3132  while not Task.Terminated do begin
    3233    API.WriteText('test');
    33     API.DrawText(Point(10, 10), 'Text');
    34     API.DrawLine(Point(20, 20), Point(100, 100));
    35     API.Sleep(OneSecond);
     34    API.DrawRect(Rect(60, 60, 180, 180), $ffffff);
     35    API.DrawText(Point(10, 10), 'Text', 0);
     36    Angle := Frac(Now / (10 * OneSecond)) * 2 * Pi;
     37    API.DrawLine(Point(120, 120), Point(Trunc(120 + Cos(Angle) * 60), Trunc(120 + Sin(Angle) * 60)), 0);
     38    API.Sleep(OneMillisecond * 100);
    3639    //API.ReadMessage(Message);
    3740  end;

  • trunk/ChronOS.lpi

    r7 r8  
    6666      </local>
    6767    </RunParams>
    68     <RequiredPackages Count="1">
     68    <RequiredPackages Count="2">
    6969      <Item1>
     70        <PackageName Value="Kernel"/>
     71        <DefaultFilename Value="Packages/Kernel/Kernel.lpk" Prefer="True"/>
     72      </Item1>
     73      <Item2>
    7074        <PackageName Value="LCL"/>
    71       </Item1>
     75      </Item2>
    7276    </RequiredPackages>
    73     <Units Count="15">
     77    <Units Count="7">
    7478      <Unit0>
    7579        <Filename Value="ChronOS.lpr"/>
    … …  
    8589      </Unit1>
    8690      <Unit2>
    87         <Filename Value="System/UKernel.pas"/>
    88         <IsPartOfProject Value="True"/>
    89         <UnitName Value="UKernel"/>
    90       </Unit2>
    91       <Unit3>
    92         <Filename Value="UFileSystem.pas"/>
    93         <IsPartOfProject Value="True"/>
    94         <UnitName Value="UFileSystem"/>
    95       </Unit3>
    96       <Unit4>
    9791        <Filename Value="Apps/UClock.pas"/>
    9892        <IsPartOfProject Value="True"/>
    9993        <UnitName Value="UClock"/>
    100       </Unit4>
    101       <Unit5>
     94      </Unit2>
     95      <Unit3>
    10296        <Filename Value="Apps/UMemoryManager.pas"/>
    10397        <IsPartOfProject Value="True"/>
    10498        <UnitName Value="UMemoryManager"/>
    105       </Unit5>
    106       <Unit6>
    107         <Filename Value="System/UAPI.pas"/>
    108         <IsPartOfProject Value="True"/>
    109         <UnitName Value="UAPI"/>
    110       </Unit6>
    111       <Unit7>
     99      </Unit3>
     100      <Unit4>
    112101        <Filename Value="Platform/Base/UPlatformBase.pas"/>
    113102        <IsPartOfProject Value="True"/>
    114103        <UnitName Value="UPlatformBase"/>
    115       </Unit7>
    116       <Unit8>
    117         <Filename Value="UList.pas"/>
    118         <IsPartOfProject Value="True"/>
    119         <UnitName Value="UList"/>
    120       </Unit8>
    121       <Unit9>
    122         <Filename Value="System/UApp.pas"/>
    123         <IsPartOfProject Value="True"/>
    124         <UnitName Value="UApp"/>
    125       </Unit9>
    126       <Unit10>
     104      </Unit4>
     105      <Unit5>
    127106        <Filename Value="UThreadEx.pas"/>
    128107        <IsPartOfProject Value="True"/>
    129108        <UnitName Value="UThreadEx"/>
    130       </Unit10>
    131       <Unit11>
    132         <Filename Value="UMemory.pas"/>
    133         <IsPartOfProject Value="True"/>
    134         <UnitName Value="UMemory"/>
    135       </Unit11>
    136       <Unit12>
     109      </Unit5>
     110      <Unit6>
    137111        <Filename Value="Forms/UFormTerminal.pas"/>
    138112        <IsPartOfProject Value="True"/>
    … …  
    141115        <ResourceBaseClass Value="Form"/>
    142116        <UnitName Value="UFormTerminal"/>
    143       </Unit12>
    144       <Unit13>
    145         <Filename Value="UClasses.pas"/>
    146         <IsPartOfProject Value="True"/>
    147         <UnitName Value="UClasses"/>
    148       </Unit13>
    149       <Unit14>
    150         <Filename Value="System/UGraphics.pas"/>
    151         <IsPartOfProject Value="True"/>
    152         <UnitName Value="UGraphics"/>
    153       </Unit14>
     117      </Unit6>
    154118    </Units>
    155119  </ProjectOptions>
    … …  
    161125    <SearchPaths>
    162126      <IncludeFiles Value="$(ProjOutDir)"/>
    163       <OtherUnitFiles Value="Apps;Platform/Base;Forms;System"/>
     127      <OtherUnitFiles Value="Apps;Platform/Base;Forms"/>
    164128      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
    165129    </SearchPaths>
    … …  
    180144        <StackChecks Value="True"/>
    181145      </Checks>
     146      <VerifyObjMethodCallValidity Value="True"/>
    182147    </CodeGeneration>
    183148    <Linking>

  • trunk/ChronOS.lpr

    r7 r8  
    1010  {$ENDIF}
    1111  Interfaces, // this includes the LCL widgetset
    12   Forms, SysUtils, UFormMain, UKernel, UFileSystem, UClock, UMemoryManager,
    13   UAPI, UPlatformBase, UList, UApp, UThreadEx, UMemory, UFormTerminal, UClasses,
    14   UGraphics;
     12  Forms, SysUtils, UFormMain, UClock, UMemoryManager,
     13  UPlatformBase, UThreadEx, UFormTerminal;
    1514
    1615{$R *.res}

  • trunk/Forms/UFormMain.lfm

    r7 r8  
    2020    Align = alClient
    2121    OnClick = PaintBox1Click
     22    OnPaint = PaintBox1Paint
    2223    OnResize = PaintBox1Resize
    2324  end

  • trunk/Forms/UFormMain.pas

    r7 r8  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ExtCtrls, Menus, ActnList, UKernel, UMemory;
     9  ExtCtrls, Menus, ActnList, UKernel, UMemory, UDevice, UPlatformBase, LCLType;
    1010
    1111type
    … …  
    3232    procedure FormShow(Sender: TObject);
    3333    procedure PaintBox1Click(Sender: TObject);
     34    procedure PaintBox1Paint(Sender: TObject);
    3435    procedure PaintBox1Resize(Sender: TObject);
    3536  private
     37    VideoDevice: TDeviceVideoBase;
     38    SerialDevice: TBaseSerialDevice;
    3639    SerialText: string;
    3740    OriginalBounds: TRect;
    … …  
    3942    ScreenBounds: TRect;
    4043    procedure SerialDeviceReceiveDataSync;
    41     procedure SerialDeviceReceiveData(Data: TMemory);
     44    procedure SerialDeviceReceiveData(Text: string);
    4245    procedure VideoDeviceRedraw(Sender: TObject);
     46    procedure VideoDeviceRedrawSync;
    4347    procedure SwitchFullScreen;
     48    procedure EraseBackground(DC: HDC); override;
    4449  public
    4550    Kernel: TKernel;
    … …  
    5257
    5358uses
    54   UList, UApp, UAPI, UClock, UPlatformBase, UThreadEx, UFormTerminal;
     59  UList, UApp, UAPI, UClock, UThreadEx, UFormTerminal;
    5560
    5661{$R *.lfm}
    … …  
    6166var
    6267  NewApp: TApp;
    63   SerialDevice: TBaseSerialDevice;
    64   VideoDevice: TBaseVideoDevice;
    65 begin
     68begin
     69  PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
     70
    6671  Kernel := TKernel.Create;
    6772  Kernel.SchedulerClass := TBaseScheduler;
    6873  Kernel.FileSystemClass := TBaseFileSystem;
     74
    6975  SerialDevice := TBaseSerialDevice.Create;
    7076  SerialDevice.Name := 'Serial0';
    … …  
    7379  Kernel.Devices.Add(SerialDevice);
    7480
    75   VideoDevice := TBaseVideoDevice.Create;
     81  VideoDevice := TDeviceVideoBase.Create;
    7682  VideoDevice.Name := 'Video0';
    7783  VideoDevice.ClassName := 'Graphic card';
    7884  VideoDevice.OnRedraw := VideoDeviceRedraw;
    7985  VideoDevice.DPI := Screen.PixelsPerInch;
    80   VideoDevice.VideoMemorySize := Point(PaintBox1.Width, PaintBox1.Height);;
     86  VideoDevice.VideoMemorySize := Point(PaintBox1.Width, PaintBox1.Height);
     87  VideoDevice.OnModeChanged := VideoDeviceRedraw;
    8188  Kernel.Devices.Add(VideoDevice);
    8289
    … …  
    135142end;
    136143
     144procedure TFormMain.EraseBackground(DC: HDC);
     145begin
     146  //inherited EraseBackground(DC);
     147end;
     148
    137149procedure TFormMain.FormDestroy(Sender: TObject);
    138150begin
    … …  
    156168end;
    157169
     170procedure TFormMain.PaintBox1Paint(Sender: TObject);
     171var
     172  X, Y: Integer;
     173  Bitmap: TBitmap;
     174begin
     175  try
     176    Bitmap := TBitmap.Create;
     177    Bitmap.BeginUpdate;
     178    Bitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
     179
     180    if Assigned(VideoDevice.VideoMemory) then begin
     181      for Y := 0 to VideoDevice.VideoMode.Size.Y - 1 do
     182      for X := 0 to VideoDevice.VideoMode.Size.X - 1 do begin
     183        Bitmap.Canvas.Pixels[X, Y] := PInteger(VideoDevice.VideoMemory + X * VideoDevice.VideoMode.GetBytesPerPixel +
     184        Y * VideoDevice.VideoMode.GetBytesPerLine)^ and $ffffff;
     185      end;
     186    end;
     187  finally
     188    PaintBox1.Canvas.Draw(0, 0, Bitmap);
     189    Bitmap.EndUpdate;
     190    Bitmap.Free;
     191  end;
     192end;
     193
    158194procedure TFormMain.PaintBox1Resize(Sender: TObject);
    159195begin
    … …  
    165201end;
    166202
    167 procedure TFormMain.SerialDeviceReceiveData(Data: TMemory);
    168 begin
    169   SetLength(SerialText, Data.Size);
    170   Move(Data.Data^, SerialText[1], Data.Size);
     203procedure TFormMain.SerialDeviceReceiveData(Text: string);
     204begin
     205  SerialText := Text;
    171206  TThreadEx.Synchronize(TThreadEx.CurrentThread, SerialDeviceReceiveDataSync);
    172207end;
    … …  
    174209procedure TFormMain.VideoDeviceRedraw(Sender: TObject);
    175210begin
    176 
     211  TThreadEx.Synchronize(TThreadEx.CurrentThread, VideoDeviceRedrawSync);
     212end;
     213
     214procedure TFormMain.VideoDeviceRedrawSync;
     215begin
     216  PaintBox1.Refresh;
    177217end;
    178218

  • trunk/Forms/UFormTerminal.lfm

    r7 r8  
    1414    Width = 320
    1515    Align = alClient
     16    ReadOnly = True
     17    ScrollBars = ssAutoBoth
    1618    TabOrder = 0
    1719  end

  • trunk/Platform/Base/UPlatformBase.pas

    r7 r8  
    77uses
    88  Classes, SysUtils, UFileSystem, UKernel, syncobjs, UThreadEx, UMemory,
    9   DateUtils;
     9  DateUtils, UDevice, Contnrs, Graphics, Forms, UScreen;
    1010
    1111type
    … …  
    4242  end;
    4343
    44   TReceiveEvent = procedure(Data: TMemory) of object;
     44  TReceiveEvent = procedure(Text: string) of object;
    4545
    4646  { TBaseSerialDevice }
    4747
    48   TBaseSerialDevice = class(TDevice)
     48  TBaseSerialDevice = class(TDeviceSerial)
    4949  private
    5050    Lock: TCriticalSection;
    … …  
    5353    constructor Create; override;
    5454    destructor Destroy; override;
    55     procedure Service(Index: Integer; DataIn, DataOut: TMemory); override;
     55    procedure WriteText(Text: string); override;
    5656    property OnReceiveData: TReceiveEvent read FOnReceiveData write FOnReceiveData;
    5757  end;
    5858
    59   { TBaseVideoDevice }
    60 
    61   TBaseVideoDevice = class(TDevice)
     59  { TDeviceVideoBase }
     60
     61  TDeviceVideoBase = class(TDeviceVideo)
    6262  private
     63    FOnModeChanged: TNotifyEvent;
    6364    FOnRedraw: TNotifyEvent;
     65    OnModeChanged: TNotifyEvent;
     66    procedure DoRedraw;
    6467  public
    6568    VideoMemory: PByte;
    6669    VideoMemorySize: TPoint;
    6770    DPI: Integer;
    68     constructor Create; override;
    69     destructor Destroy; override;
    70     procedure Service(Index: Integer; DataIn, DataOut: TMemory); override;
     71    Canvas: TCanvas;
     72    VideoMode: TVideoMode;
     73    procedure SetMode(Mode: TVideoMode); override;
     74    procedure GetSupportedModes(Modes: TObjectList); override;
     75    function GetVideoMemory: PByte; override;
     76    procedure VideoMemoryChange; override;
     77    constructor Create; override;
     78    destructor Destroy; override;
    7179    property OnRedraw: TNotifyEvent read FOnRedraw write FOnRedraw;
     80    property OnModeChanged: TNotifyEvent read FOnModeChanged write FOnModeChanged;
    7281  end;
    7382
    7483implementation
    7584
    76 { TBaseVideoDevice }
    77 
    78 constructor TBaseVideoDevice.Create;
     85{ TDeviceVideoBase }
     86
     87procedure TDeviceVideoBase.DoRedraw;
     88begin
     89
     90end;
     91
     92procedure TDeviceVideoBase.SetMode(Mode: TVideoMode);
     93begin
     94  if (VideoMode.Size.X <> Mode.Size.X) or
     95    (VideoMode.Size.Y <> Mode.Size.Y) or
     96    (VideoMode.ColorFormat <> Mode.ColorFormat) then begin
     97      VideoMode.Size := Mode.Size;
     98      VideoMode.ColorFormat := Mode.ColorFormat;
     99      if Assigned(FOnModeChanged) then
     100        FOnModeChanged(Self);
     101    end;
     102end;
     103
     104procedure TDeviceVideoBase.GetSupportedModes(Modes: TObjectList);
     105var
     106  NewMode: TVideoMode;
     107begin
     108  Modes.Clear;
     109  NewMode := TVideoMode.Create;
     110  NewMode.Size := Point(320, 240);
     111  NewMode.ColorFormat := cfRGBA8;
     112  Modes.Add(NewMode);
     113  NewMode := TVideoMode.Create;
     114  NewMode.Size := Point(640, 480);
     115  NewMode.ColorFormat := cfRGBA8;
     116  Modes.Add(NewMode);
     117{  NewMode := TVideoMode.Create;
     118  NewMode.Size := Point(800, 600);
     119  NewMode.ColorFormat := cfRGBA8;
     120  Modes.Add(NewMode);
     121  NewMode := TVideoMode.Create;
     122  NewMode.Size := Point(1024, 768);
     123  NewMode.ColorFormat := cfRGBA8;
     124  Modes.Add(NewMode);
     125  NewMode := TVideoMode.Create;
     126  NewMode.Size := Point(1278, 1024);
     127  NewMode.ColorFormat := cfRGBA8;
     128  Modes.Add(NewMode);
     129  NewMode := TVideoMode.Create;
     130  NewMode.Size := Point(1920, 1080);
     131  NewMode.ColorFormat := cfRGBA8;
     132  Modes.Add(NewMode);
     133  }
     134end;
     135
     136function TDeviceVideoBase.GetVideoMemory: PByte;
     137begin
     138  VideoMemory := GetMem(VideoMode.GetBytesPerImage);
     139  FillDWord(VideoMemory^, VideoMode.GetBytesPerImage div 4, $ffffff);
     140  Result := VideoMemory;
     141end;
     142
     143procedure TDeviceVideoBase.VideoMemoryChange;
     144begin
     145  if Assigned(FOnRedraw) then FOnRedraw(Self);
     146end;
     147
     148constructor TDeviceVideoBase.Create;
    79149begin
    80150  inherited Create;
    81 end;
    82 
    83 destructor TBaseVideoDevice.Destroy;
    84 begin
    85   inherited Destroy;
    86 end;
    87 
    88 procedure TBaseVideoDevice.Service(Index: Integer; DataIn, DataOut: TMemory);
    89 begin
    90   if Index = 0 then begin
    91     // Redraw to screen
    92     if Assigned(FOnRedraw) then
    93       FOnRedraw(Self);
    94   end else
    95   if Index = 1 then begin
    96     // Get video memory
    97     VideoMemory := GetMem(VideoMemorySize.X * VideoMemorySize.Y * 4);
    98 //    DataOut^ := VideoMemory;
    99 //    DataOut^ := VideoMemory;
    100   end else inherited;
     151  VideoMode := TVideoMode.Create;
     152end;
     153
     154destructor TDeviceVideoBase.Destroy;
     155begin
     156  VideoMode.Free;
     157  inherited Destroy;
    101158end;
    102159
    … …  
    116173end;
    117174
    118 procedure TBaseSerialDevice.Service(Index: Integer; DataIn, DataOut: TMemory);
    119 begin
    120   if Index = 0 then begin
    121     Lock.Acquire;
    122     if Assigned(FOnReceiveData) then
    123       FOnReceiveData(DataIn);
    124     Lock.Release;
    125   end else inherited;
     175procedure TBaseSerialDevice.WriteText(Text: string);
     176begin
     177  Lock.Acquire;
     178  if Assigned(FOnReceiveData) then
     179    FOnReceiveData(Text);
     180  Lock.Release;
    126181end;
    127182
Note: See TracChangeset for help on using the changeset viewer.