Changeset 19 for trunk

Timestamp:

Jan 21, 2018, 11:33:15 PM (7 years ago)

Author:

chronos

Message:

• Added: Locking of video memory because it is accessed by main thread and also application threads.

Location:

trunk

Files:

• ChronOS.lpi (modified) (3 diffs)
• ChronOS.res (modified) ( previous)
• Forms/UFormMain.pas (modified) (4 diffs)
• Packages/Kernel/UDevice.pas (modified) (3 diffs)
• Packages/Kernel/UScreen.pas (modified) (5 diffs)
• Platform/Base/UPlatformBase.pas (modified) (2 diffs)

trunk/ChronOS.lpi

@@ -9 +9 @@
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
       <Icon Value="0"/>
     </General>
@@ -24 +27 @@
           <SearchPaths>
             <IncludeFiles Value="$(ProjOutDir)"/>
-            <OtherUnitFiles Value="Apps;Platform/Base"/>
-            <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+            <OtherUnitFiles Value="Apps;Platform/Base;Forms"/>
+            <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-${BuildMode}"/>
           </SearchPaths>
           <Parsing>
@@ -117 +120 @@
       <IncludeFiles Value="$(ProjOutDir)"/>
       <OtherUnitFiles Value="Apps;Platform/Base;Forms"/>
-      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-${BuildMode}"/>
     </SearchPaths>
     <Parsing>

trunk/Forms/UFormMain.pas

@@ -200 +200 @@
   SizeY: Integer;
 begin
-{  var
-    X, Y: Integer;
-    PixelPtr: PInteger;
-    PixelRowPtr: PInteger;
-    RawImage: TRawImage;
-    BytePerPixel: Integer;
-    SourcePixelPtr: Integer;
-  begin
-    try
-      Bitmap.BeginUpdate;
-      RawImage := Bitmap.RawImage;
-      PixelRowPtr := PInteger(RawImage.Data);
-      BytePerPixel := RawImage.Description.BitsPerPixel div 8;
-      for Y := 0 to Bitmap.Height - 1 do begin
-        PixelPtr := PixelRowPtr;
-        for X := 0 to Bitmap.Width - 1 do begin
-          SourcePixelPtr := TMatter(Matter[Surface.ItemsXY[Trunc(X / Bitmap.Width * Surface.Count.X),
-              Trunc(Y / Bitmap.Height * Surface.Count.Y)]]).Color;
-          PixelPtr^ := SwapBRComponent(SourcePixelPtr);
-          Inc(PByte(PixelPtr), BytePerPixel);
-        end;
-        Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);
-      end;
-    finally
-      Bitmap.EndUpdate;
-    end;
-}
   try
     TempBitmap.SetSize(VideoDevice.VideoMode.Size.X, VideoDevice.VideoMode.Size.Y);
@@ -234 +207 @@
     DestBytePerPixel := RawImage.Description.BitsPerPixel div 8;
     DestBytePerLine := RawImage.Description.BytesPerLine;
+    VideoDevice.Lock.Acquire;
     if Assigned(VideoDevice.VideoMemory) then begin
       SourceBytePerPixel := VideoDevice.VideoMode.GetBytesPerPixel;
@@ -252 +226 @@
       end;
     end;
+    VideoDevice.Lock.Release;
   finally
     TempBitmap.EndUpdate;
@@ -266 +241 @@
   VideoMode.Size := TPoint.Create(Width, Height);
   VideoDevice.VideoMode := VideoMode;
+  VideoMode.Free;
 end;
 

trunk/Packages/Kernel/UDevice.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Contnrs, UList, UGraphics;
+  Classes, SysUtils, Contnrs, UList, UGraphics, syncobjs;
 
 type
@@ -36 +36 @@
     function GetVideoMemory: PByte; virtual;
   public
+    Lock: TCriticalSection;
     constructor Create; override;
+    destructor Destroy; override;
     procedure GetSupportedModes(Modes: TObjectList); virtual;
     procedure VideoMemoryChange; virtual;
@@ -104 +106 @@
   ClassName := 'Video device';
   FVideoMode := TVideoMode.Create;
+  Lock := TCriticalSection.Create;
+end;
+
+destructor TDeviceVideo.Destroy;
+begin
+  Lock.Free;
+  FVideoMode.Free;
+  inherited Destroy;
 end;
 

trunk/Packages/Kernel/UScreen.pas

@@ -14 +14 @@
 
   TScreenCanvas = class(TCanvas)
+  private
+    procedure SetPixelInternal(P: TPoint; Color: TColor);
+  public
     Screen: TScreen;
     procedure DrawText(Pos: TPoint; Text: string; Color: TColor); override;
@@ -57 +60 @@
   I: Integer;
 begin
-  if Abs(P2.X - P1.X) > Abs(P2.Y - P1.Y) then begin
-    for I := 0 to Abs(P2.X - P1.X) - 1 do
-      SetPixel(TPoint.Create(Trunc(P1.X + I * Sign(P2.X - P1.X)),
-        Trunc(P1.Y + (P2.Y - P1.Y) / Abs(P2.X - P1.X) * I)), Color);
-  end else begin
-    for I := 0 to Abs(P2.Y - P1.Y) - 1 do
-      SetPixel(TPoint.Create(Trunc(P1.X + (P2.X - P1.X) / Abs(P2.Y - P1.Y) * I),
-        Trunc(P1.Y + I * Sign(P2.Y - P1.Y))), Color);
+  TDeviceVideo(Screen.Device).Lock.Acquire;
+  try
+    if Abs(P2.X - P1.X) > Abs(P2.Y - P1.Y) then begin
+      for I := 0 to Abs(P2.X - P1.X) - 1 do
+        SetPixelInternal(TPoint.Create(Trunc(P1.X + I * Sign(P2.X - P1.X)),
+          Trunc(P1.Y + (P2.Y - P1.Y) / Abs(P2.X - P1.X) * I)), Color);
+    end else begin
+      for I := 0 to Abs(P2.Y - P1.Y) - 1 do
+        SetPixelInternal(TPoint.Create(Trunc(P1.X + (P2.X - P1.X) / Abs(P2.Y - P1.Y) * I),
+          Trunc(P1.Y + I * Sign(P2.Y - P1.Y))), Color);
+    end;
+  finally
+    TDeviceVideo(Screen.Device).Lock.Release;
   end;
   Screen.VideoMemoryUpdated;
@@ -73 +81 @@
   X, Y: Integer;
 begin
-  for Y := Rect.Top to Rect.Bottom do
-  for X := Rect.Left to Rect.Right do
-    SetPixel(TPoint.Create(X, Y), Color);
+  TDeviceVideo(Screen.Device).Lock.Acquire;
+  try
+    for Y := Rect.Top to Rect.Bottom do
+    for X := Rect.Left to Rect.Right do
+      SetPixelInternal(TPoint.Create(X, Y), Color);
+  finally
+    TDeviceVideo(Screen.Device).Lock.Release;
+  end;
   Screen.VideoMemoryUpdated;
 end;
@@ -83 +96 @@
   X, Y: Integer;
 begin
-  for Y := Rect.Top to Rect.Bottom do begin
-    SetPixel(TPoint.Create(Rect.Left, Y), Color);
-    SetPixel(TPoint.Create(Rect.Right, Y), Color);
-  end;
-  for X := Rect.Left to Rect.Right do begin
-    SetPixel(TPoint.Create(X, Rect.Top), Color);
-    SetPixel(TPoint.Create(X, Rect.Bottom), Color);
+  TDeviceVideo(Screen.Device).Lock.Acquire;
+  try
+    for Y := Rect.Top to Rect.Bottom do begin
+      SetPixelInternal(TPoint.Create(Rect.Left, Y), Color);
+      SetPixelInternal(TPoint.Create(Rect.Right, Y), Color);
+    end;
+    for X := Rect.Left to Rect.Right do begin
+      SetPixelInternal(TPoint.Create(X, Rect.Top), Color);
+      SetPixelInternal(TPoint.Create(X, Rect.Bottom), Color);
+    end;
+  finally
+    TDeviceVideo(Screen.Device).Lock.Release;
   end;
   Screen.VideoMemoryUpdated;
@@ -95 +113 @@
 
 procedure TScreenCanvas.SetPixel(P: TPoint; Color: TColor);
+begin
+  TDeviceVideo(Screen.Device).Lock.Acquire;
+  try
+    if Assigned(Screen.VideoMemory) and
+      TRectangle.Create(TPoint.Create(0, 0), Screen.Size).PointInside(P) then
+      PInteger(Screen.VideoMemory + P.X * Screen.BytesPerPixel + P.Y * Screen.BytesPerLine)^ := Color;
+  finally
+    TDeviceVideo(Screen.Device).Lock.Release;
+  end;
+end;
+
+procedure TScreenCanvas.SetPixelInternal(P: TPoint; Color: TColor);
 begin
   if Assigned(Screen.VideoMemory) and

trunk/Platform/Base/UPlatformBase.pas

@@ -93 +93 @@
     (VideoMode.Size.Y <> Mode.Size.Y) or
     (VideoMode.ColorFormat <> Mode.ColorFormat) then begin
-      VideoMode.Size := Mode.Size;
-      VideoMode.ColorFormat := Mode.ColorFormat;
-      ReAllocMem(VideoMemory, VideoMode.GetBytesPerImage);
-      FillDWord(VideoMemory^, VideoMode.GetBytesPerImage div 4, $ffffff);
+      Lock.Acquire;
+      try
+        if Mode.GetBytesPerImage <> VideoMode.GetBytesPerImage then begin
+          ReAllocMem(VideoMemory, Mode.GetBytesPerImage);
+          FillDWord(VideoMemory^, Mode.GetBytesPerImage div 4, $ffffff);
+        end;
+        VideoMode.Size := Mode.Size;
+        VideoMode.ColorFormat := Mode.ColorFormat;
+      finally
+        Lock.Release;
+      end;
       if Assigned(FOnModeChanged) then
         FOnModeChanged(Self);
@@ -151 +158 @@
 destructor TDeviceVideoBase.Destroy;
 begin
-  VideoMode.Free;
   inherited Destroy;
 end;