Changeset 8 for trunk/Platform/Base/UPlatformBase.pas

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.

File:

• trunk/Platform/Base/UPlatformBase.pas (modified) (4 diffs)

trunk/Platform/Base/UPlatformBase.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, UFileSystem, UKernel, syncobjs, UThreadEx, UMemory,
-  DateUtils;
+  DateUtils, UDevice, Contnrs, Graphics, Forms, UScreen;
 
 type
@@ -42 +42 @@
   end;
 
-  TReceiveEvent = procedure(Data: TMemory) of object;
+  TReceiveEvent = procedure(Text: string) of object;
 
   { TBaseSerialDevice }
 
-  TBaseSerialDevice = class(TDevice)
+  TBaseSerialDevice = class(TDeviceSerial)
   private
     Lock: TCriticalSection;
@@ -53 +53 @@
     constructor Create; override;
     destructor Destroy; override;
-    procedure Service(Index: Integer; DataIn, DataOut: TMemory); override;
+    procedure WriteText(Text: string); override;
     property OnReceiveData: TReceiveEvent read FOnReceiveData write FOnReceiveData;
   end;
 
-  { TBaseVideoDevice }
-
-  TBaseVideoDevice = class(TDevice)
+  { TDeviceVideoBase }
+
+  TDeviceVideoBase = class(TDeviceVideo)
   private
+    FOnModeChanged: TNotifyEvent;
     FOnRedraw: TNotifyEvent;
+    OnModeChanged: TNotifyEvent;
+    procedure DoRedraw;
   public
     VideoMemory: PByte;
     VideoMemorySize: TPoint;
     DPI: Integer;
-    constructor Create; override;
-    destructor Destroy; override;
-    procedure Service(Index: Integer; DataIn, DataOut: TMemory); override;
+    Canvas: TCanvas;
+    VideoMode: TVideoMode;
+    procedure SetMode(Mode: TVideoMode); override;
+    procedure GetSupportedModes(Modes: TObjectList); override;
+    function GetVideoMemory: PByte; 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
 
-{ TBaseVideoDevice }
-
-constructor TBaseVideoDevice.Create;
+{ TDeviceVideoBase }
+
+procedure TDeviceVideoBase.DoRedraw;
+begin
+
+end;
+
+procedure TDeviceVideoBase.SetMode(Mode: TVideoMode);
+begin
+  if (VideoMode.Size.X <> Mode.Size.X) or
+    (VideoMode.Size.Y <> Mode.Size.Y) or
+    (VideoMode.ColorFormat <> Mode.ColorFormat) then begin
+      VideoMode.Size := Mode.Size;
+      VideoMode.ColorFormat := Mode.ColorFormat;
+      if Assigned(FOnModeChanged) then
+        FOnModeChanged(Self);
+    end;
+end;
+
+procedure TDeviceVideoBase.GetSupportedModes(Modes: TObjectList);
+var
+  NewMode: TVideoMode;
+begin
+  Modes.Clear;
+  NewMode := TVideoMode.Create;
+  NewMode.Size := Point(320, 240);
+  NewMode.ColorFormat := cfRGBA8;
+  Modes.Add(NewMode);
+  NewMode := TVideoMode.Create;
+  NewMode.Size := Point(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
+  VideoMemory := GetMem(VideoMode.GetBytesPerImage);
+  FillDWord(VideoMemory^, VideoMode.GetBytesPerImage div 4, $ffffff);
+  Result := VideoMemory;
+end;
+
+procedure TDeviceVideoBase.VideoMemoryChange;
+begin
+  if Assigned(FOnRedraw) then FOnRedraw(Self);
+end;
+
+constructor TDeviceVideoBase.Create;
 begin
   inherited Create;
-end;
-
-destructor TBaseVideoDevice.Destroy;
-begin
-  inherited Destroy;
-end;
-
-procedure TBaseVideoDevice.Service(Index: Integer; DataIn, DataOut: TMemory);
-begin
-  if Index = 0 then begin
-    // Redraw to screen
-    if Assigned(FOnRedraw) then
-      FOnRedraw(Self);
-  end else
-  if Index = 1 then begin
-    // Get video memory
-    VideoMemory := GetMem(VideoMemorySize.X * VideoMemorySize.Y * 4);
-//    DataOut^ := VideoMemory;
-//    DataOut^ := VideoMemory;
-  end else inherited;
+  VideoMode := TVideoMode.Create;
+end;
+
+destructor TDeviceVideoBase.Destroy;
+begin
+  VideoMode.Free;
+  inherited Destroy;
 end;
 
@@ -116 +173 @@
 end;
 
-procedure TBaseSerialDevice.Service(Index: Integer; DataIn, DataOut: TMemory);
-begin
-  if Index = 0 then begin
-    Lock.Acquire;
-    if Assigned(FOnReceiveData) then
-      FOnReceiveData(DataIn);
-    Lock.Release;
-  end else inherited;
+procedure TBaseSerialDevice.WriteText(Text: string);
+begin
+  Lock.Acquire;
+  if Assigned(FOnReceiveData) then
+    FOnReceiveData(Text);
+  Lock.Release;
 end;