Patch from Giuliano to improve the new X11 timer and to implement screenshot taking in X11 + My improvements over the code to implement GetDeviceSize

git-svn-id: trunk@36558 -

lcl/interfaces/customdrawn/customdrawn_x11proc.pas

@@ -11,6 +11,7 @@ uses
   Types, Classes, SysUtils,
   fpimage, fpcanvas, ctypes,
   X, XLib,
+  BaseUnix,Unix,
   // Custom Drawn Canvas
   IntfGraphics, lazcanvas,
   //
@@ -47,10 +48,31 @@ type
     destructor destroy;
     end;
 
-const
-  KMsToDateTime = 86400000; // # of milliseconds in a day
+  { TCDX11TimerThread }
+
+  TCDX11TimerThread = class(TThread)
+  private
+    rfds: TFDset;
+    Timeout: cint;
+    retval,ByteRec: integer;
+  protected
+    procedure Execute; override;
+  public
+    X11TimerPipeIn,X11TimerPipeOut: Integer; // Pipe to Timer
+    MainLoopPipeIn,MainLoopPipeOut: Integer; // Pipe to Main Loop
+    constructor Create(CreateSuspended: Boolean; const StackSize: SizeUInt=DefaultStackSize
+       );
+   end;
+
+var
+  X11TimerThread: TCDX11TimerThread;
+
 {$endif}
 
+const
+  fpFD_SETSIZE = 1024; // As defined in typesizes.h
+  KMsToDateTime = 86400000; // # of milliseconds in a day
+
 function RectToXRect(const ARect: TRect): TXRectangle;
 function XRectToRect(const ARect: TXRectangle): TRect;
 function XButtonToMouseButton(const XButton: cint; var MouseButton: TMouseButton): Boolean;
@@ -59,6 +81,7 @@ function GetXEventName(Event: LongInt): String;
 implementation
 {$ifdef CD_X11_UseNewTimer}
 uses CustomDrawnInt;
+
 {$endif}
 
 function RectToXRect(const ARect: TRect): TXRectangle;
@@ -111,6 +134,89 @@ begin
 end;
 
 {$ifdef CD_X11_UseNewTimer}
+
+{ TCDX11TimerThread }
+
+procedure TCDX11TimerThread.Execute;
+var
+  Answ: array [0..80] of byte;
+  Answlen: Integer;
+  ANextTime: TDateTime absolute answ;
+  NextToExpire,TNow,TDiff: TDateTime;
+  HeadTimer: TCDX11Timer;
+begin
+    retval:= AssignPipe(X11TimerPipeIn,X11TimerPipeOut);
+    retval:= AssignPipe(MainLoopPipeIn,MainLoopPipeOut);
+    WriteLn('TimerThread: Started!');
+    NextToExpire:= Now+10; // Ten days in future - high enough
+    Repeat
+      TNow := Now;
+      if NextToExpire > TNow+7 then // no timers until next week,
+        //or List Head just processed
+        Timeout:= -1 // wait until the first timer is activated
+      else if CDWidgetSet.XTimerListHead = nil then
+        Timeout:= -1
+      else begin
+        // Pick up timer which will expire first
+        // We must recalculate each time, because a message in between
+        // may have interrupted our timeout.
+        HeadTimer := CDWidgetSet.XTimerListHead;
+        NextToExpire:= HeadTimer.Expires;
+        // Compute how many ms from now
+        TDiff:= NextToExpire-Now;
+        Timeout:= DateTimeToMilliseconds(Tdiff);
+        // if already expired (we're late) handle right now
+        if Timeout <=0 then Timeout:= 0;
+        end;
+      // Wait for a message telling that the timer list has changed,
+      // until our current timer (if any) expires
+      fpFD_ZERO(rfds);
+      fpFD_SET(X11TimerPipeIn,rfds);
+      retval:= fpSelect(fpFD_SETSIZE,@rfds,nil,nil,Timeout);
+      if (retval <> 0) then begin // We've received a message
+         ByteRec := FileRead(X11TimerPipeIn,Answ,sizeof(Answ));
+         // Debugln doesn't like to be executed in a thread which isn't the MT
+         // and after a number of writes crashes with a DISK FULL error!
+         //WriteLn('TimerThread: Got message!');
+         if ByteRec >=SizeOf(ANextTime) then begin
+           if ANextTime < NextToExpire then NextToExpire:=ANextTime;
+           end;
+         //WriteLn(Format('TimerThread: Message received - NextTime= %s',[DateTimeToStr(ANextTime)]));
+         end
+      else begin  // A Timer has expired - Send a message to Main Loop
+        // message content is irrelevant. We put Timeout for debug
+        ANextTime:= Timeout;
+        FileWrite(MainLoopPipeOut,Answ,sizeOf(Timeout));
+        // we don't want to send twice a messages for the same timer
+        // When timer is processed, the list is updateded and we will receive
+        // a new message. So we set NextToExpire to a value larger than any
+        // expectable value
+        NextToExpire:= TNow+10;
+        end;
+      until Terminated;
+end;
+
+constructor TCDX11TimerThread.Create(CreateSuspended: Boolean;
+  const StackSize: SizeUInt);
+var
+  thisTM: TThreadManager;
+begin
+  GetThreadManager(thisTM);
+  if not Assigned(thisTM.InitManager) then begin
+    Raise Exception.Create
+    ('You must define UseCThread (-dUseCThreads in Project Options-> Compiler Options) in order to run this program!');
+    end;
+  inherited Create (CreateSuspended);
+  {Priority := 99; // it would be nice to assign priority and policy
+  Policy := SCHED_RR;} // but it depends on application rights to do so
+  FreeOnTerminate := True;
+  // Pipes do not yet exist. Better make it clear
+  MainLoopPipeIn:= -1;
+  MainLoopPipeOut:= -1;
+  X11TimerPipeIn:= -1;
+  X11TimerPipeOut:= -1;
+end;
+
 { TCDX11Timer }
 
 constructor TCDX11Timer.create(WSInterval: Integer; WSfunc: TWSTimerProc);
@@ -120,6 +226,11 @@ var
   TDiff,TNow: TDateTime;
 {$endif}
 begin
+{$ifdef TimerUseCThreads}
+  if X11TimerThread.Suspended then begin
+     X11TimerThread.Suspended:= False; // Activate Timer Thread
+     end;
+{$endif}
   Interval:= WSInterval; // Interval in ms
   Func:= WSfunc; // OnTimeEvent
   Expires:= Now + Interval/KMsToDateTime; //
@@ -136,6 +247,8 @@ end;
 procedure TCDX11Timer.Insert;
 var
   lTimer,PTimer,NTimer: TCDX11Timer;
+  ABuffer: array[0..15] of byte;
+  ExpireTime: TDateTime absolute ABuffer;
 begin
   {$ifdef Verbose_CD_X11_Timer}
   DebugLn(Format('TCDX11Timer Insert: Interval := %d',[Interval]));
@@ -172,6 +285,10 @@ begin
       Previous := nil;
       end;
   end;
+  {$ifdef TimerUseCThreads}
+  ExpireTime := Expires; // Copy Expire time to Buffer and send to TimerThread
+  FileWrite(X11TimerThread.X11TimerPipeOut,ABuffer,SizeOf(ExpireTime));
+  {$endif}
   {$ifdef Verbose_CD_X11_Timer}
   lTimer := CDWidgetSet.XTimerListHead;
   while lTimer <> Nil do begin
@@ -204,13 +321,18 @@ begin
 end;
 
 procedure TCDX11Timer.Expired;
-{$ifdef Verbose_CD_X11_Timer}
 var
+  TNow: TDateTime;
+{$ifdef Verbose_CD_X11_Timer}
   lInterval,lTInterval: Integer;
-  TDiff,TNow: TDateTime;
+  TDiff: TDateTime;
 {$endif}
 begin
+  TNow:= Now;
   Expires:= Expires+Interval/KMsToDateTime; // don't leak
+  while Expires <= TNow do begin // but if we're late, let's skip some! Bad kludge
+    Expires:= Expires+Interval/KMsToDateTime;
+    end;
   {$ifdef Verbose_CD_X11_Timer}
   TNow:= Now;
   TDiff:= Expires - TNow;

lcl/interfaces/customdrawn/customdrawndefines.inc

@@ -49,7 +49,19 @@
 // ==================
 {$define CD_X11_NewNativePaint}
 {$define CD_X11_UseLCL_MainLoop}
-{.$define CD_X11_UseNewTimer}
+{$define CD_X11_UseNewTimer}
+
+// ==================
+// X11 experimental options
+// ==================
+{$ifdef CD_X11}
+// To be able to use TThreads, UseCThreads must be defined in the application!
+{ $ifdef UseCTthreads}
+ {$ifdef CD_X11_UseNewTimer}
+   { $define TimerUseCThreads}
+ {$endif}
+{ $endif}
+{$endif}
 
 // ==================
 // Debug options
@@ -62,3 +74,4 @@
 {.$define VerboseCDForms}
 {.$define VerboseCDX11WinAPI}
 {.$define VerboseCDAccessibility}
+

lcl/interfaces/customdrawn/customdrawnint.pas

@@ -36,7 +36,7 @@ uses
   // Platform specific
   {$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
   {$ifdef CD_Cocoa}MacOSAll, CocoaAll, customdrawn_cocoaproc, CocoaGDIObjects,{$endif}
-  {$ifdef CD_X11}X, XLib, XUtil, BaseUnix, customdrawn_x11proc, {contnrs,}{$ifdef CD_UseNativeText}xft, fontconfig,{$endif}{$endif}
+  {$ifdef CD_X11}X, XLib, XUtil, BaseUnix, customdrawn_x11proc,{$ifdef CD_UseNativeText}xft, fontconfig,{$endif}{$endif}
   {$ifdef CD_Android}
   customdrawn_androidproc, jni, bitmap, log, keycodes,
   {$endif}
@@ -428,7 +428,6 @@ const
   {$ifdef CD_X11}
 const
   CDBackendNativeHandle = nhtX11TWindow;
-  fpFD_SETSIZE = 1024; // As defined in deprecated Libc. Large enough for any practical purpose
   {$define CD_HasNativeFormHandle}
   {$endif}
   {$ifdef CD_Cocoa}

lcl/interfaces/customdrawn/customdrawnlclintf_x11.inc

@@ -151,6 +151,52 @@ end;
        So get this internal bitmap and pass it to RawImage_FromBitmap
  ------------------------------------------------------------------------------}
 function TCDWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean;
+var
+  Image: XLib.PXImage;
+  //XImage: XLib.TXImage;
+  Pdata: Pchar;
+  RootWindow: TWindow;
+  PlaneMask: culong;
+  lx,ly,lwidth,lheight: culong;
+  lDataLength: Integer;
+
+procedure DescriptionFix(var ArawImage: TRawImage; Awidth,AHeight: Integer);
+Var
+  Description: TRawImageDescription absolute ArawImage.Description;
+begin
+  // setup an artificial ScanLineImage with format RGB 32 bit, 32bit depth format
+  //FillChar(Description, SizeOf(Description), 0);
+  with Description do begin;
+    Format := ricfRGBA;
+    Depth := 24; // used bits per pixel
+    Width := AWidth;
+    Height := AHeight;
+    BitOrder := riboBitsInOrder;
+    ByteOrder := riboLSBFirst;
+    LineOrder := riloTopToBottom;
+    BitsPerPixel := 32; // bits per pixel. can be greater than Depth.
+    LineEnd := rileDWordBoundary;
+    RedPrec := 8; // red precision. bits for red
+    RedShift := 16;
+    GreenPrec := 8;
+    GreenShift := 8; // bitshift. Direction: from least to most signifikant
+    BluePrec := 8;
+    BlueShift := 0;
+    AlphaPrec := 0;
+    AlphaShift := 0;
+    MaskBitsPerPixel := 1;
+    MaskShift:= 0;
+    MaskLineEnd:=rileByteBoundary;
+    MaskBitOrder:=riboBitsInOrder;
+    PaletteColorCount:= 0;
+    PaletteBitsPerIndex:=0;
+    PaletteShift:= 0;
+    PaletteLineEnd:=rileTight;
+    PaletteBitOrder:=riboBitsInOrder;
+    PaletteByteOrder:=riboLSBFirst;
+  end;
+end;
+
 begin
   {$ifdef VerboseCDWinAPI}
     DebugLn('Trace:> [WinAPI GetRawImageFromDevice] SrcDC: ', dbghex(ADC),
@@ -158,11 +204,50 @@ begin
      ' SrcHeight: ', dbgs(ARect.Bottom - ARect.Top));
   {$endif}
 
-  // todo: copy only passed rectangle
-
+  // create a raw Image to hold screenshot
+  lx:=ARect.Left;
+  ly:=ARect.Top;
+  lwidth:=ARect.Right-ARect.Left;
+  lheight:=Arect.Bottom-ARect.Top;
+  ARawImage.Init;
+  // We should get the description from the drawable but this may do
+  ARawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(lwidth, lheight);
+  ARawImage.CreateData(True);
+  // Get root Window
+  RootWindow:= XDefaultRootWindow(FDisplay);
+  // Get Plane mask
+  PlaneMask:=XAllPlanes();
+  // Take the screenshot
+  Image:= XGetImage(
+               FDisplay,RootWindow, // Screen, Window
+               lx,ly, // x , y
+               lwidth,lheight, // width, height
+               PlaneMask, // All planes
+               ZPixmap);  // Image format
+  // copy screen shot to our rawImage
+  lDataLength:= ARawImage.DataSize;
+  System.Move( Image^.Data^,ARawImage.Data^,lDataLength);
+  // We should fix the description from the drawable but this will do for now
+  DescriptionFix(ARawImage,lwidth,lheight);
+  ARawImage.Mask:=nil;
+  ARawImage.Palette:=nil;
   Result := True;
 
-  ARawImage.Init;
+(*  ARawImage.Init;
+  ARawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(ScreenBitmapWidth, ScreenBitmapHeight);
+
+  // Take the screenshot
+  screenshotImage := CGDisplayCreateImage(CGMainDisplayID()); // Requires 10.6+
+
+  // Draw it to our screen bitmap
+  lRect := CGRectMake(0, 0, ScreenBitmapWidth, ScreenBitmapHeight);
+  CGContextDrawImage(ScreenBitmapContext, lRect, screenshotImage);
+
+  // Now copy the data
+  ScreenImage.GetRawImage(lScreenRawImage, False);
+  ARawImage.CreateData(False);
+  lDataLength := Min(lScreenRawImage.DataSize, ARawImage.DataSize);
+  System.Move(lScreenRawImage.Data^, ARawImage.Data^, lDataLength); *)
 end;
 
 procedure TCDWidgetset.ShowVirtualKeyboard();

lcl/interfaces/customdrawn/customdrawnobject_x11.inc

@@ -115,6 +115,9 @@ begin
   XWindowList := TStringList.Create;
   {$ifdef CD_X11_UseNewTimer}
   XTimerListHead := nil;
+  {$ifdef TimerUseCThreads}
+  X11TimerThread := TCDX11TimerThread.Create(False); // Create Not Suspended
+  {$endif}
   {$endif}
 end;
 
@@ -538,6 +541,60 @@ end;*)
   Passes execution control to X11, but processes timer messages while waiting
  ------------------------------------------------------------------------------}
 procedure TCDWidgetSet.AppWaitMessage;
+{$ifdef TimerUseCThreads}
+var
+  // timer variables
+  rfds: baseunix.TFDSet;
+  xconnnum, selectresult: integer;
+  AnyTimerProcessed: Boolean = False;
+  AnyXEventReceived: Boolean = False;
+  lTimer: TCDX11Timer;
+  i: Integer;
+  lBuf: array [0..15] of byte; // to hold timer message
+  LRecTime: Integer absolute lBuf;
+  lTimeoutInterval: Integer; // miliseconds
+begin
+  lTimeoutInterval:= -1; // Wait Forever for an event
+  xconnnum := XConnectionNumber(FDisplay);
+  if XPending(FDisplay) > 0 then Exit; // We have a X message to process
+
+  while not Application.Terminated do begin
+
+    fpFD_ZERO(rfds);
+    fpFD_SET(xconnnum, rfds);
+
+    // Add all other X connections
+    for i := 0 to XConnections.Count-1 do
+      fpFD_SET(cint(PtrInt(XConnections.Items[i])), rfds);
+    // Add Timer Connection, if activated
+    if X11TimerThread.MainLoopPipeIn > 0 then
+      fpFD_SET(X11TimerThread.MainLoopPipeIn,rfds);
+    // wait both for an X message and a Timer message
+    selectresult := fpSelect(fpFD_SETSIZE, @rfds, nil, nil, lTimeoutInterval);
+    if selectresult <> 0 then begin
+      // Timer event?
+      if fpFD_ISSET(X11TimerThread.MainLoopPipeIn,rfds) <> 0 then begin
+        // We are notified that the first timer in list need service
+        FileRead(X11TimerThread.MainLoopPipeIn,lBuf,SizeOf(lBuf));
+        if XTimerListHead <> nil then begin
+          lTimer := XTimerListHead;
+          lTimer.Expired;
+          // this will execute the timer code, and put next timer on top
+          // of the list.
+          //DebugLn(Format('AppWaitMessage: Timer Message=%d',[LRecTime]));
+          AnyTimerProcessed := True;
+        end;
+      end;
+      if fpFD_ISSET(xconnnum,rfds) <> 0 then AnyXEventReceived:= True;
+      for i := 0 to XConnections.Count-1 do begin
+        if fpFD_ISSET(cint(PtrInt(XConnections.Items[i])), rfds) <> 0 then
+          AnyXEventReceived:= True;
+        end;
+      end;
+    if AnyXEventReceived or AnyTimerProcessed then exit;
+    end;
+end;
+{$else}
 var
   // timer variables
   rfds: baseunix.TFDSet;
@@ -555,7 +612,10 @@ begin
   IsFirstTimeout := True;
 
   {$ifdef CD_X11_UseNewTimer}
-  if XTimerListHead = nil then lTimeoutInterval:= -1
+  if XTimerListHead = nil then begin
+    lTimeoutInterval:= -1;
+    lTimer:=Nil;
+  end
   else begin
     lTimer := XTimerListHead;
     lTimeoutInterval:= trunc((lTimer.Expires-now)*KMsToDateTime);
@@ -659,6 +719,7 @@ begin
     end;
   end;
 end;
+{$endif TimerUseCThreads}
 
 {------------------------------------------------------------------------------
   Method: TWinCEWidgetSet.AppTerminate

lcl/interfaces/customdrawn/customdrawnwinapi.inc

@@ -2894,9 +2894,33 @@ begin
     else
       Result := 0;
   end;
+end;*)
+
+function TCDWidgetSet.GetDeviceSize(DC: HDC; var P: TPoint): Boolean;
+Var
+  ScrSize: TPoint;
+  LazDC: TLazCanvas;
+begin
+  Result:= False;
+
+  // Screen size
+  if DC = 0 then
+  begin
+    P.X:= GetSystemMetrics(SM_CXSCREEN);
+    P.Y:= GetSystemMetrics(SM_CYSCREEN);
+    Exit(True);
+  end;
+
+  if not IsValidDC(DC) then exit;
+  LazDC := TLazCanvas(DC);
+
+  P.X := LazDC.Width;
+  P.Y := LazDC.Height;
+
+  Result := True;
 end;
 
-function TQtWidgetSet.GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer;
+(*function TQtWidgetSet.GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer;
 begin
   Result := 0;
   {$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}

lcl/interfaces/customdrawn/customdrawnwinapih.inc

@@ -118,7 +118,7 @@ function GetCursorPos(var lpPoint: TPoint ): Boolean; override;
 function GetDC(hWnd: HWND): HDC; override;
 //function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; override;
 function GetDeviceCaps(DC: HDC; Index: Integer): Integer; override;
-//function GetDeviceSize(DC: HDC; var P: TPoint): Boolean; Override;
+function GetDeviceSize(DC: HDC; var P: TPoint): Boolean; Override;
 (*function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; Override;
 function GetDoubleClickTime: UINT; override;*)
 function GetFocus: HWND; override;