* updated ptcpas and ptcgraph to the latest 0.99.16 release candidate

packages/graph/src/ptcgraph/ptcgraph.pp

@@ -2790,7 +2790,8 @@ end;
        exit;
 
      PTCModeList := Copy(PTCWrapperObject.Modes);
-     SortModes(Low(PTCModeList), High(PTCModeList));
+     if Length(PTCModeList) > 0 then
+       SortModes(Low(PTCModeList), High(PTCModeList));
 
      Has320x200 := ContainsExactResolution(320, 200);
      Has320x240 := ContainsExactResolution(320, 240);

packages/ptc/docs/CHANGES.txt

@@ -1,5 +1,18 @@
-0.99.x
+0.99.16
  - added and implemented SetMousePos in unit ptcmouse
+ - applied patch by Nicolas QSO <[email protected]> that fixes the handling of
+   international keyboards in Xvnc sessions.
+ - added support for macOS via the Cocoa API. Tested in macOS 11.6.1 Big Sur on
+   a Mac mini with an Apple M1 chip. Supported features:
+     fixed windowed output
+     keyboard input
+     the ptcgraph and ptccrt units also work
+   Features that are still missing:
+     mouse input
+     fullscreen output
+     resizable windowed output
+     OpenGL support
+     returning a mode list
 
 0.99.15
  - dead key support under Windows and X11 (via XIM)

packages/ptc/docs/README.txt

@@ -1,4 +1,4 @@
-PTCPas 0.99.15
+PTCPas 0.99.16
 Nikolay Nikolov ([email protected])
 
 PTCPas is a free, portable framebuffer library, written in Free Pascal. It is
@@ -30,6 +30,7 @@ Supported consoles:
              compatible.)
   X11 (on linux and other unix-like OSes, supports XRandR, XF86VidMode, XShm
        and xf86dga extensions)
+  Cocoa for macOS (tested on macOS 11.6.1 Big Sur on an Apple M1 Mac mini.)
   Vesa 1.0+ (DOS. Supports LFB and banked video memory access)
   VGA (DOS, fakemodes, mode13h, etc...)
   CGA (DOS, added by me just for fun ... and maybe some day I'll even add

packages/ptc/docs/TODO.txt

@@ -1,4 +1,6 @@
- - Mac OS X support
+ - mouse input for macOS
+ - OpenGL support for macOS
+ - fullscreen and resizable window support for macOS
  - mouse grab support
  - add more event types (expose, focus in, focus out, etc.)
  - mouse support for the x11 dga console

packages/ptc/examples/keyboard3.pp

@@ -123,6 +123,7 @@ begin
     PTCKEY_MINUS        : Result := 'PTCKEY_MINUS';
     PTCKEY_BACKQUOTE    : Result := 'PTCKEY_BACKQUOTE';
     PTCKEY_QUOTE        : Result := 'PTCKEY_QUOTE';
+    PTCKEY_COMMAND      : Result := 'PTCKEY_COMMAND';
     else
       Result := '';
   end;

packages/ptc/fpmake.pp

@@ -195,6 +195,8 @@ begin
     T:=P.Targets.AddUnit('ptceventqueue.pp');
     with T.Dependencies do
       begin
+        AddInclude('ptceventqueue_st.inc');
+        AddInclude('ptceventqueue_mt.inc');
         AddUnit('ptc');
       end;
     T:=P.Targets.AddUnit('ptcwrapper.pp');

packages/ptc/src/cocoa/cocoaconsoled.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2015 Nikolay Nikolov ([email protected])
+    Copyright (C) 2015, 2021 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -38,7 +38,16 @@ type
   private
     FConsole: TCocoaConsole;
   public
-    function windowShouldClose(sender: id): Boolean;
+    function windowShouldClose(sender: id): ObjCBOOL;
+  end;
+
+  { NSPTCView }
+
+  NSPTCView = objcclass(NSView)
+  private
+    FConsole: TCocoaConsole;
+  public
+    procedure drawRect(dirtyRect: NSRect); override;
   end;
 
   { NSPTCWindow }
@@ -86,7 +95,7 @@ type
     FWindow: NSPTCWindow;
     FImageRep: NSBitmapImageRep;
     FImage: NSImage;
-    FView: NSView;
+    FView: NSPTCView;
 
     class procedure MaybeCreateAutoreleasePool;
 

packages/ptc/src/cocoa/cocoaconsolei.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2015 Nikolay Nikolov ([email protected])
+    Copyright (C) 2015, 2021 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -42,7 +42,7 @@ end;
 
 { NSPTCWindowDelegate }
 
-function NSPTCWindowDelegate.windowShouldClose(sender: id): Boolean;
+function NSPTCWindowDelegate.windowShouldClose(sender: id): ObjCBOOL;
 begin
   if Assigned(FConsole) then
     Result := FConsole.HandleWindowShouldClose(sender)
@@ -50,6 +50,14 @@ begin
     Result := True;
 end;
 
+{ NSPTCView }
+
+procedure NSPTCView.drawRect(dirtyRect: NSRect);
+begin
+  if Assigned(FConsole) then
+    FConsole.FImage.drawInRect_fromRect_operation_fraction(NSMakeRect(0, 0, FConsole.FWidth, FConsole.FHeight), NSZeroRect, NSCompositeCopy, 1.0);
+end;
+
 { NSPTCWindow }
 
 procedure NSPTCWindow.keyDown(theEvent: NSEvent);
@@ -287,8 +295,8 @@ begin
     62:  exit(PTCKEY_CONTROL);  // Right Ctrl
     58,                     // Left Option (Alt) key
     61:  exit(PTCKEY_ALT);  // Right Option (Alt) key
-    55,            // Left Command key
-    54:  exit(0);  // Right Command key
+    55:  exit(PTCKEY_COMMAND);  // Left Command key
+    54:  exit(PTCKEY_COMMAND);  // Right Command key
     57:  exit(PTCKEY_CAPSLOCK);
     82:  exit(PTCKEY_NUMPAD0);
     83:  exit(PTCKEY_NUMPAD1);
@@ -320,29 +328,43 @@ var
   kcode: cushort;
   modflags: NSUInteger;
   Code, UniCode: Integer;
-  Alt, Shift, Control: Boolean;
   Press: Boolean;
   PressAndRelease: Boolean = False;
+  Characters: NSString;
+  ModifierKeys: TPTCModifierKeys;
 begin
   evtype := theEvent.type_;
   kcode := theEvent.keyCode;
   modflags := theEvent.modifierFlags;
+  if evtype in [NSKeyDown, NSKeyUp] then
+    Characters := theEvent.characters
+  else
+    Characters := nil;
   LOG('cocoa key event ' + Method + ' type=' + IntToStr(evtype) + ' keyCode=' + IntToStr(kcode) + ' modifierFlags=' + IntToStr(modflags));
   Result := False;
   Code := TranslateKeyCode(kcode);
-  Unicode := 32;
-  Alt := (modflags and NSAlternateKeyMask) <> 0;
-  Shift := (modflags and NSShiftKeyMask) <> 0;
-  Control := (modflags and NSControlKeyMask) <> 0;
+  Unicode := 0;
+  if Assigned(Characters) and (Characters.length = 1) then
+    Unicode := Characters.characterAtIndex(0);
+  ModifierKeys := [];
+  if (modflags and NSAlternateKeyMask) <> 0 then
+    Include(ModifierKeys, pmkAlt);
+  if (modflags and NSShiftKeyMask) <> 0 then
+    Include(ModifierKeys, pmkShift);
+  if (modflags and NSControlKeyMask) <> 0 then
+    Include(ModifierKeys, pmkControl);
+  if (modflags and NSCommandKeyMask) <> 0 then
+    Include(ModifierKeys, pmkCommand);
   case evtype of
     NSKeyDown: Press := True;
     NSKeyUp: Press := False;
     NSFlagsChanged:
       begin
         case Code of
-          PTCKEY_SHIFT: Press := Shift;
-          PTCKEY_CONTROL: Press := Control;
-          PTCKEY_ALT: Press := Alt;
+          PTCKEY_SHIFT: Press := pmkShift in ModifierKeys;
+          PTCKEY_CONTROL: Press := pmkControl in ModifierKeys;
+          PTCKEY_ALT: Press := pmkAlt in ModifierKeys;
+          PTCKEY_COMMAND: Press := pmkCommand in ModifierKeys;
           PTCKEY_CAPSLOCK:
             begin
               { we only receive a modifierFlags message when caps lock is pressed down,
@@ -360,17 +382,17 @@ begin
   end;
   if PressAndRelease then
   begin
-    FEventQueue.AddEvent(TPTCKeyEventFactory.CreateNew(Code, Unicode, Alt, Shift, Control, True));
-    FEventQueue.AddEvent(TPTCKeyEventFactory.CreateNew(Code, Unicode, Alt, Shift, Control, False));
+    FEventQueue.AddEvent(TPTCKeyEventFactory.CreateNew(Code, Unicode, ModifierKeys, True));
+    FEventQueue.AddEvent(TPTCKeyEventFactory.CreateNew(Code, Unicode, ModifierKeys, False));
   end
   else
-    FEventQueue.AddEvent(TPTCKeyEventFactory.CreateNew(Code, Unicode, Alt, Shift, Control, Press));
+    FEventQueue.AddEvent(TPTCKeyEventFactory.CreateNew(Code, Unicode, ModifierKeys, Press));
 end;
 
 function TCocoaConsole.HandleCocoaMouseEvent(theEvent: NSEvent;
   const Method: string): Boolean;
 begin
-  Writeln('HandleCocoaMouseEvent ', Method, ' ', theEvent.type_);
+  //Writeln('HandleCocoaMouseEvent ', Method, ' ', theEvent.type_);
   Result := False;
 end;
 
@@ -418,7 +440,7 @@ begin
   FPalette := TPTCPalette.Create;
   FClip := TPTCArea.Create;
   FArea := TPTCArea.Create;
-  FFormat := TPTCFormat.Create;
+  FFormat := TPTCFormatFactory.CreateNew;
   FEventQueue := TEventQueue.Create;
 
   Configure('/usr/share/ptcpas/ptcpas.conf');
@@ -608,7 +630,7 @@ end;
 
 procedure TCocoaConsole.Open(const ATitle: string; APages: Integer);
 begin
-  Open(ATitle, TPTCFormat.Create(32, $FF0000, $FF00, $FF), APages);
+  Open(ATitle, TPTCFormatFactory.CreateNew(32, $FF0000, $FF00, $FF), APages);
 end;
 
 procedure TCocoaConsole.Open(const ATitle: string; AFormat: IPTCFormat;
@@ -637,6 +659,7 @@ begin
   pool := NSAutoreleasePool.alloc.init;
   try
     NSApplication.sharedApplication;
+    NSApp.setActivationPolicy(NSApplicationActivationPolicyRegular);
     NSApp.finishLaunching;
 
     rct := NSMakeRect(0, 0, AWidth, AHeight);
@@ -658,23 +681,24 @@ begin
       AWidth,
       AHeight,
       8,
-      4,
-      True,
+      3,
+      False,
       False,
       NSDeviceRGBColorSpace,
       0,
       32);
     {$ifdef FPC_BIG_ENDIAN}
-      FFormat := TPTCFormat.Create(32, $FF000000, $FF0000, $FF00);
+      FFormat := TPTCFormatFactory.CreateNew(32, $FF000000, $FF0000, $FF00);
     {$else}
-      FFormat := TPTCFormat.Create(32, $FF, $FF00, $FF0000);
+      FFormat := TPTCFormatFactory.CreateNew(32, $FF, $FF00, $FF0000);
     {$endif}
     FPitch := FImageRep.bytesPerRow;
 
     FImage := NSImage.alloc.initWithSize(NSMakeSize(AWidth, AHeight));
     FImage.addRepresentation(FImageRep);
 
-    FView := NSView.alloc.initWithFrame(NSMakeRect(0, 0, AWidth, AHeight));
+    FView := NSPTCView.alloc.initWithFrame(NSMakeRect(0, 0, AWidth, AHeight));
+    FView.FConsole := Self;
 
     FWindow.setContentView(FView);
 
@@ -754,11 +778,7 @@ var
 begin
   pool := NSAutoreleasePool.alloc.init;
   try
-    FView.lockFocus;
-    FImage.drawInRect_fromRect_operation_fraction(NSMakeRect(0, 0, FWidth, FHeight), NSZeroRect, NSCompositeCopy, 1.0);
-    FView.unlockFocus;
-
-    FWindow.flushWindow;
+    FView.setNeedsDisplay_(True);
   finally
     pool.release;
   end;

packages/ptc/src/core/keyeventd.inc

@@ -36,7 +36,8 @@ type
     pmkNumLockActive, pmkNumLockPressed,
     pmkCapsLockActive, pmkCapsLockPressed,
     pmkScrollLockActive, pmkScrollLockPressed,
-    pmkRightKey, pmkNumPadKey, pmkDeadKey);
+    pmkRightKey, pmkNumPadKey, pmkDeadKey,
+    pmkCommand);
   TPTCModifierKeys = set of TPTCModifierKey;
   IPTCKeyEvent = interface(IPTCEvent)
     ['{9BD1CD41-1DF6-4392-99DC-885EADB6D85A}']
@@ -191,3 +192,4 @@ const
   PTCKEY_MINUS        = $BD;
   PTCKEY_BACKQUOTE    = $C0;
   PTCKEY_QUOTE        = $DE;
+  PTCKEY_COMMAND      = $100;

packages/ptc/src/ptc.pp

@@ -69,7 +69,7 @@ uses
 {$ENDIF FPDOC}
 
 const
-  PTCPAS_VERSION = 'PTCPas 0.99.15';
+  PTCPAS_VERSION = 'PTCPas 0.99.16';
 
 type
   PUint8  = ^Uint8;

packages/ptc/src/ptcwrapper/ptcwrapper.pp

@@ -1,6 +1,6 @@
 {
     Free Pascal PTCPas framebuffer library threaded wrapper
-    Copyright (C) 2010, 2011, 2012, 2013, 2019 Nikolay Nikolov ([email protected])
+    Copyright (C) 2010, 2011, 2012, 2013, 2019, 2021 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -29,536 +29,12 @@
     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
-unit ptcwrapper;
+{$if defined(GO32V2) or defined(DARWIN)}
+  {$define PTCWRAPPER_SINGLE_THREADED}
+{$endif}
 
-{$MODE objfpc}{$H+}
-
-{$IFDEF GO32V2}
-{ this unit does not work under go32v2, because DOS does not support threads,
-  but this hack at least makes it compile, so we don't need to exclude it from
-  the makefiles for now. }
-{$DEFINE NoSyncObjsHack}
-{$ENDIF GO32V2}
-
-interface
-
-uses
-  {$IFDEF unix}cthreads,{$ENDIF}
-  SysUtils, Classes{$IFNDEF NoSyncObjsHack}, syncobjs{$ENDIF}, ptc, ptceventqueue;
-
-type
-{$IFDEF NoSyncObjsHack}
-  TCriticalSection = class
-  public
-    procedure Acquire;
-    procedure Release;
-  end;
-{$ENDIF NoSyncObjsHack}
-  TPTCWrapperOpenType = (pwotDefault, pwotFormat, pwotWidthHeightFormat, pwotMode);
-  TPTCWrapperOpenRequest = record
-    OpenType: TPTCWrapperOpenType;
-    Title: string;
-    SurfaceWidth, SurfaceHeight: Integer;
-    Width, Height: Integer;
-    Format: IPTCFormat;
-    Mode: IPTCMode;
-    VirtualPages: Integer;
-    Pages: Integer;
-
-    Processed: Boolean;
-    Success: Boolean;
-  end;
-
-  TPTCWrapperCloseRequest = record
-    Processed: Boolean;
-    Success: Boolean;
-  end;
-
-  TPTCWrapperOptionRequest = record
-    Option: string;
-
-    Processed: Boolean;
-    Result: Boolean;
-  end;
-
-  TPTCWrapperGetModesRequest = record
-    Processed: Boolean;
-
-    Result: TPTCModeList;
-  end;
-
-  TPTCWrapperMoveMouseToRequest = record
-    X, Y: Integer;
-
-    Processed: Boolean;
-    Result: Boolean;
-  end;
-
-  TPTCWrapperThread = class(TThread)
-  private
-    FConsole: IPTCConsole;
-    FSurface: array of IPTCSurface;
-    FPalette: IPTCPalette;
-    FSurfaceCriticalSection: TCriticalSection;
-    FNeedsUpdate: Boolean;
-    FPaletteNeedsUpdate: Boolean;
-    FCurrentVisualPage: Integer;
-
-    FEventQueue: TEventQueue;
-
-    FPixels: array of Pointer;
-    FPaletteData: Pointer;
-
-    FOpen: Boolean;
-    {FError?}
-
-    FOpenRequest: TPTCWrapperOpenRequest;
-    FCloseRequest: TPTCWrapperCloseRequest;
-    FOptionRequest: TPTCWrapperOptionRequest;
-    FGetModesRequest: TPTCWrapperGetModesRequest;
-    FMoveMouseToRequest: TPTCWrapperMoveMouseToRequest;
-  protected
-    procedure Execute; override;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    procedure Open(const ATitle: string; AVirtualPages: Integer; APages: Integer = 0);
-    procedure Open(const ATitle: string; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
-    procedure Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight, AWidth, AHeight: Integer; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
-    procedure Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight: Integer; AMode: IPTCMode; AVirtualPages: Integer; APages: Integer = 0);
-    procedure Close;
-
-    function Option(const AOption: string): Boolean;
-
-    function Modes: TPTCModeList;
-
-    procedure SetVisualPage(AVisualPage: Integer);
-
-    function Lock(AVirtualPage: Integer): Pointer;
-    procedure Unlock;
-
-    function PaletteLock: Pointer;
-    procedure PaletteUnlock;
-
-    function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
-    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
-
-    function MoveMouseTo(AX, AY: Integer): Boolean;
-
-    property IsOpen: Boolean read FOpen;
-  end;
-
-implementation
-
-{$IFDEF NoSyncObjsHack}
-procedure TCriticalSection.Acquire;
-begin
-end;
-
-procedure TCriticalSection.Release;
-begin
-end;
-{$ENDIF NoSyncObjsHack}
-
-constructor TPTCWrapperThread.Create;
-begin
-  FOpen := False;
-  FNeedsUpdate := False;
-
-  FOpenRequest.Processed := True;
-  FCloseRequest.Processed := True;
-  FOptionRequest.Processed := True;
-  FGetModesRequest.Processed := True;
-  FMoveMouseToRequest.Processed := True;
-
-  FSurfaceCriticalSection := TCriticalSection.Create;
-
-  inherited Create(False);
-end;
-
-destructor TPTCWrapperThread.Destroy;
-begin
-  FreeAndNil(FSurfaceCriticalSection);
-  inherited;
-end;
-
-procedure TPTCWrapperThread.Execute;
-  procedure GetEvents;
-  var
-    Event: IPTCEvent;
-    NextEventAvailable: Boolean;
-  begin
-    repeat
-      NextEventAvailable := FConsole.NextEvent(Event, False, PTCAnyEvent);
-      if NextEventAvailable then
-        FEventQueue.AddEvent(Event);
-    until not NextEventAvailable;
-  end;
-
-  procedure ProcessRequests;
-  var
-    I: Integer;
-  begin
-    if not FOpenRequest.Processed then
-    begin
-      for I := Low(FSurface) to High(FSurface) do
-        FSurface[I] := nil;
-      with FOpenRequest do
-      begin
-        SetLength(FSurface, VirtualPages);
-        case OpenType of
-          pwotDefault:
-            begin
-              FConsole.Open(Title, Pages);
-              for I := Low(FSurface) to High(FSurface) do
-                FSurface[I] := TPTCSurfaceFactory.CreateNew(FConsole.Width, FConsole.Height, FConsole.Format);
-            end;
-          pwotFormat:
-            begin
-              FConsole.Open(Title, Format, Pages);
-              for I := Low(FSurface) to High(FSurface) do
-                FSurface[I] := TPTCSurfaceFactory.CreateNew(FConsole.Width, FConsole.Height, Format);
-            end;
-          pwotWidthHeightFormat:
-            begin
-              FConsole.Open(Title, Width, Height, Format, Pages);
-              for I := Low(FSurface) to High(FSurface) do
-                FSurface[I] := TPTCSurfaceFactory.CreateNew(SurfaceWidth, SurfaceHeight, Format);
-            end;
-          pwotMode:
-            begin
-              FConsole.Open(Title, Mode, Pages);
-              for I := Low(FSurface) to High(FSurface) do
-                FSurface[I] := TPTCSurfaceFactory.CreateNew(SurfaceWidth, SurfaceHeight, Mode.Format);
-            end;
-        end;
-      end;
-
-      SetLength(FPixels, Length(FSurface));
-      for I := Low(FSurface) to High(FSurface) do
-      begin
-        FPixels[I] := FSurface[I].Lock;
-        FSurface[I].Unlock;
-      end;
-      FOpen := True;
-      FOpenRequest.Success := True;
-      FOpenRequest.Processed := True;
-    end;
-
-    if not FCloseRequest.Processed then
-    begin
-      FConsole.Close;
-      for I := Low(FSurface) to High(FSurface) do
-        FSurface[I] := nil;
-      SetLength(FSurface, 0);
-      SetLength(FPixels, 0);
-      FOpen := False;
-      FCloseRequest.Success := True;
-      FCloseRequest.Processed := True;
-    end;
-
-    if not FOptionRequest.Processed then
-    begin
-      FOptionRequest.Result := FConsole.Option(FOptionRequest.Option);
-      FOptionRequest.Processed := True;
-    end;
-
-    if not FGetModesRequest.Processed then
-    begin
-      FGetModesRequest.Result := FConsole.Modes;
-      FGetModesRequest.Processed := True;
-    end;
-
-    if not FMoveMouseToRequest.Processed then
-    begin
-      FMoveMouseToRequest.Result := FConsole.MoveMouseTo(FMoveMouseToRequest.X, FMoveMouseToRequest.Y);
-      FMoveMouseToRequest.Processed := True;
-    end;
-  end;
-
-begin
-  try
-    FConsole := TPTCConsoleFactory.CreateNew;
-    FConsole.Option('intercept window close');
-
-    FEventQueue := TEventQueue.Create;
-    FPalette := TPTCPaletteFactory.CreateNew;
-    FPaletteData := FPalette.Data;
-
-    FOpen := False;
-    while not Terminated do
-    begin
-      ThreadSwitch;
-      Sleep(10);
-
-      FSurfaceCriticalSection.Acquire;
-      try
-        ProcessRequests;
-
-        if FOpen then
-        begin
-          GetEvents;
-
-          if FNeedsUpdate or FPaletteNeedsUpdate then
-          begin
-            if FPaletteNeedsUpdate then
-              FSurface[FCurrentVisualPage].Palette(FPalette);
-            FSurface[FCurrentVisualPage].Copy(FConsole);
-            if FPaletteNeedsUpdate then
-              FConsole.Palette(FPalette);
-            FConsole.Update;
-
-            FNeedsUpdate := False;
-            FPaletteNeedsUpdate := False;
-          end;
-        end;
-      finally
-        FSurfaceCriticalSection.Release;
-      end;
-    end;
-
-  finally
-    FOpen := False;
-
-    FreeAndNil(FEventQueue);
-
-    if Assigned(FConsole) then
-      FConsole.Close;
-
-    SetLength(FSurface, 0);
-    FConsole := nil;
-  end;
-end;
-
-procedure TPTCWrapperThread.Open(const ATitle: string; AVirtualPages: Integer; APages: Integer = 0);
-begin
-  FSurfaceCriticalSection.Acquire;
-  try
-    with FOpenRequest do
-    begin
-      OpenType := pwotDefault;
-      Title := ATitle;
-      VirtualPages := AVirtualPages;
-      Pages := APages;
-      Processed := False;
-    end;
-  finally
-    FSurfaceCriticalSection.Release;
-  end;
-
-  repeat
-    ThreadSwitch;
-  until FOpenRequest.Processed;
-end;
-
-procedure TPTCWrapperThread.Open(const ATitle: string; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
-begin
-  FSurfaceCriticalSection.Acquire;
-  try
-    with FOpenRequest do
-    begin
-      OpenType := pwotFormat;
-      Title := ATitle;
-      Format := AFormat;
-      VirtualPages := AVirtualPages;
-      Pages := APages;
-      Processed := False;
-    end;
-  finally
-    FSurfaceCriticalSection.Release;
-  end;
-
-  repeat
-    ThreadSwitch;
-  until FOpenRequest.Processed;
-end;
-
-procedure TPTCWrapperThread.Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight, AWidth, AHeight: Integer; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
-begin
-  FSurfaceCriticalSection.Acquire;
-  try
-    with FOpenRequest do
-    begin
-      OpenType := pwotWidthHeightFormat;
-      Title := ATitle;
-      SurfaceWidth := ASurfaceWidth;
-      SurfaceHeight := ASurfaceHeight;
-      Width := AWidth;
-      Height := AHeight;
-      Format := AFormat;
-      VirtualPages := AVirtualPages;
-      Pages := APages;
-      Processed := False;
-    end;
-  finally
-    FSurfaceCriticalSection.Release;
-  end;
-
-  repeat
-    ThreadSwitch;
-  until FOpenRequest.Processed;
-end;
-
-procedure TPTCWrapperThread.Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight: Integer; AMode: IPTCMode; AVirtualPages: Integer; APages: Integer = 0);
-begin
-  FSurfaceCriticalSection.Acquire;
-  try
-    with FOpenRequest do
-    begin
-      OpenType := pwotMode;
-      Title := ATitle;
-      SurfaceWidth := ASurfaceWidth;
-      SurfaceHeight := ASurfaceHeight;
-      Mode := AMode;
-      VirtualPages := AVirtualPages;
-      Pages := APages;
-      Processed := False;
-    end;
-  finally
-    FSurfaceCriticalSection.Release;
-  end;
-
-  repeat
-    ThreadSwitch;
-  until FOpenRequest.Processed;
-end;
-
-procedure TPTCWrapperThread.Close;
-begin
-  FSurfaceCriticalSection.Acquire;
-  try
-    with FCloseRequest do
-    begin
-      Processed := False;
-    end;
-  finally
-    FSurfaceCriticalSection.Release;
-  end;
-
-  repeat
-    ThreadSwitch;
-  until FCloseRequest.Processed;
-end;
-
-function TPTCWrapperThread.Option(const AOption: string): Boolean;
-begin
-  FSurfaceCriticalSection.Acquire;
-  try
-    with FOptionRequest do
-    begin
-      Option := AOption;
-      Processed := False;
-    end;
-  finally
-    FSurfaceCriticalSection.Release;
-  end;
-
-  repeat
-    ThreadSwitch;
-  until FOptionRequest.Processed;
-  Result := FOptionRequest.Result;
-end;
-
-function TPTCWrapperThread.Modes: TPTCModeList;
-begin
-  FSurfaceCriticalSection.Acquire;
-  try
-    with FGetModesRequest do
-    begin
-      Processed := False;
-    end;
-  finally
-    FSurfaceCriticalSection.Release;
-  end;
-
-  repeat
-    ThreadSwitch;
-  until FGetModesRequest.Processed;
-  Result := FGetModesRequest.Result;
-end;
-
-procedure TPTCWrapperThread.SetVisualPage(AVisualPage: Integer);
-begin
-  FSurfaceCriticalSection.Acquire;
-  try
-    if FCurrentVisualPage <> AVisualPage then
-    begin
-      FCurrentVisualPage := AVisualPage;
-      FNeedsUpdate := True;
-      FPaletteNeedsUpdate := True;  { todo: no need to set this always }
-    end;
-  finally
-    FSurfaceCriticalSection.Release;
-  end;
-end;
-
-function TPTCWrapperThread.Lock(AVirtualPage: Integer): Pointer;
-begin
-  FSurfaceCriticalSection.Acquire;
-  if AVirtualPage = FCurrentVisualPage then
-    FNeedsUpdate := True;
-  Result := FPixels[AVirtualPage];
-end;
-
-procedure TPTCWrapperThread.Unlock;
-begin
-  FSurfaceCriticalSection.Release;
-end;
-
-function TPTCWrapperThread.PaletteLock: Pointer;
-begin
-  FSurfaceCriticalSection.Acquire;
-  FPaletteNeedsUpdate := True;
-  Result := FPaletteData;
-end;
-
-procedure TPTCWrapperThread.PaletteUnlock;
-begin
-  FSurfaceCriticalSection.Release;
-end;
-
-function TPTCWrapperThread.NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
-begin
-  repeat
-    ThreadSwitch;
-
-    FSurfaceCriticalSection.Acquire;
-    AEvent := FEventQueue.NextEvent(AEventMask);
-    FSurfaceCriticalSection.Release;
-  until (not AWait) or (AEvent <> nil);
-  Result := AEvent <> nil;
-end;
-
-function TPTCWrapperThread.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
-begin
-  repeat
-    ThreadSwitch;
-
-    FSurfaceCriticalSection.Acquire;
-    Result := FEventQueue.PeekEvent(AEventMask);
-    FSurfaceCriticalSection.Release;
-  until (not AWait) or (Result <> nil);
-end;
-
-function TPTCWrapperThread.MoveMouseTo(AX, AY: Integer): Boolean;
-begin
-  FSurfaceCriticalSection.Acquire;
-  try
-    with FMoveMouseToRequest do
-    begin
-      X := AX;
-      Y := AY;
-      Processed := False;
-    end;
-  finally
-    FSurfaceCriticalSection.Release;
-  end;
-
-  repeat
-    ThreadSwitch;
-  until FMoveMouseToRequest.Processed;
-  Result := FMoveMouseToRequest.Result;
-end;
-
-end.
+{$ifdef PTCWRAPPER_SINGLE_THREADED}
+  {$I ptcwrapper_st.inc}
+{$else PTCWRAPPER_SINGLE_THREADED}
+  {$I ptcwrapper_mt.inc}
+{$endif PTCWRAPPER_SINGLE_THREADED}

packages/ptc/src/ptcwrapper/ptcwrapper_mt.inc

@@ -0,0 +1,540 @@
+{
+    Free Pascal PTCPas framebuffer library multi threaded wrapper
+    Copyright (C) 2010, 2011, 2012, 2013, 2019, 2021 Nikolay Nikolov ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+}
+
+unit ptcwrapper;
+
+{$MODE objfpc}{$H+}
+
+interface
+
+uses
+  {$IFDEF unix}cthreads,{$ENDIF}
+  SysUtils, Classes, syncobjs, ptc, ptceventqueue;
+
+type
+  TPTCWrapperOpenType = (pwotDefault, pwotFormat, pwotWidthHeightFormat, pwotMode);
+  TPTCWrapperOpenRequest = record
+    OpenType: TPTCWrapperOpenType;
+    Title: string;
+    SurfaceWidth, SurfaceHeight: Integer;
+    Width, Height: Integer;
+    Format: IPTCFormat;
+    Mode: IPTCMode;
+    VirtualPages: Integer;
+    Pages: Integer;
+
+    Processed: Boolean;
+    Success: Boolean;
+  end;
+
+  TPTCWrapperCloseRequest = record
+    Processed: Boolean;
+    Success: Boolean;
+  end;
+
+  TPTCWrapperOptionRequest = record
+    Option: string;
+
+    Processed: Boolean;
+    Result: Boolean;
+  end;
+
+  TPTCWrapperGetModesRequest = record
+    Processed: Boolean;
+
+    Result: TPTCModeList;
+  end;
+
+  TPTCWrapperMoveMouseToRequest = record
+    X, Y: Integer;
+
+    Processed: Boolean;
+    Result: Boolean;
+  end;
+
+  TPTCWrapperThread = class(TThread)
+  private
+    FConsole: IPTCConsole;
+    FSurface: array of IPTCSurface;
+    FPalette: IPTCPalette;
+    FSurfaceCriticalSection: TCriticalSection;
+    FNeedsUpdate: Boolean;
+    FPaletteNeedsUpdate: Boolean;
+    FCurrentVisualPage: Integer;
+
+    FEventQueue: TEventQueue;
+
+    FPixels: array of Pointer;
+    FPaletteData: Pointer;
+
+    FOpen: Boolean;
+    {FError?}
+
+    FOpenRequest: TPTCWrapperOpenRequest;
+    FCloseRequest: TPTCWrapperCloseRequest;
+    FOptionRequest: TPTCWrapperOptionRequest;
+    FGetModesRequest: TPTCWrapperGetModesRequest;
+    FMoveMouseToRequest: TPTCWrapperMoveMouseToRequest;
+  protected
+    procedure Execute; override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure Open(const ATitle: string; AVirtualPages: Integer; APages: Integer = 0);
+    procedure Open(const ATitle: string; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
+    procedure Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight, AWidth, AHeight: Integer; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
+    procedure Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight: Integer; AMode: IPTCMode; AVirtualPages: Integer; APages: Integer = 0);
+    procedure Close;
+
+    function Option(const AOption: string): Boolean;
+
+    function Modes: TPTCModeList;
+
+    procedure SetVisualPage(AVisualPage: Integer);
+
+    function Lock(AVirtualPage: Integer): Pointer;
+    procedure Unlock;
+
+    function PaletteLock: Pointer;
+    procedure PaletteUnlock;
+
+    function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
+    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
+
+    function MoveMouseTo(AX, AY: Integer): Boolean;
+
+    property IsOpen: Boolean read FOpen;
+  end;
+
+implementation
+
+constructor TPTCWrapperThread.Create;
+begin
+  FOpen := False;
+  FNeedsUpdate := False;
+
+  FOpenRequest.Processed := True;
+  FCloseRequest.Processed := True;
+  FOptionRequest.Processed := True;
+  FGetModesRequest.Processed := True;
+  FMoveMouseToRequest.Processed := True;
+
+  FSurfaceCriticalSection := TCriticalSection.Create;
+
+  inherited Create(False);
+end;
+
+destructor TPTCWrapperThread.Destroy;
+begin
+  FreeAndNil(FSurfaceCriticalSection);
+  inherited;
+end;
+
+procedure TPTCWrapperThread.Execute;
+  procedure GetEvents;
+  var
+    Event: IPTCEvent;
+    NextEventAvailable: Boolean;
+  begin
+    repeat
+      NextEventAvailable := FConsole.NextEvent(Event, False, PTCAnyEvent);
+      if NextEventAvailable then
+        FEventQueue.AddEvent(Event);
+    until not NextEventAvailable;
+  end;
+
+  procedure ProcessRequests;
+  var
+    I: Integer;
+  begin
+    if not FOpenRequest.Processed then
+    begin
+      for I := Low(FSurface) to High(FSurface) do
+        FSurface[I] := nil;
+      with FOpenRequest do
+      begin
+        SetLength(FSurface, VirtualPages);
+        case OpenType of
+          pwotDefault:
+            begin
+              FConsole.Open(Title, Pages);
+              for I := Low(FSurface) to High(FSurface) do
+                FSurface[I] := TPTCSurfaceFactory.CreateNew(FConsole.Width, FConsole.Height, FConsole.Format);
+            end;
+          pwotFormat:
+            begin
+              FConsole.Open(Title, Format, Pages);
+              for I := Low(FSurface) to High(FSurface) do
+                FSurface[I] := TPTCSurfaceFactory.CreateNew(FConsole.Width, FConsole.Height, Format);
+            end;
+          pwotWidthHeightFormat:
+            begin
+              FConsole.Open(Title, Width, Height, Format, Pages);
+              for I := Low(FSurface) to High(FSurface) do
+                FSurface[I] := TPTCSurfaceFactory.CreateNew(SurfaceWidth, SurfaceHeight, Format);
+            end;
+          pwotMode:
+            begin
+              FConsole.Open(Title, Mode, Pages);
+              for I := Low(FSurface) to High(FSurface) do
+                FSurface[I] := TPTCSurfaceFactory.CreateNew(SurfaceWidth, SurfaceHeight, Mode.Format);
+            end;
+        end;
+      end;
+
+      SetLength(FPixels, Length(FSurface));
+      for I := Low(FSurface) to High(FSurface) do
+      begin
+        FPixels[I] := FSurface[I].Lock;
+        FSurface[I].Unlock;
+      end;
+      FOpen := True;
+      FOpenRequest.Success := True;
+      FOpenRequest.Processed := True;
+    end;
+
+    if not FCloseRequest.Processed then
+    begin
+      FConsole.Close;
+      for I := Low(FSurface) to High(FSurface) do
+        FSurface[I] := nil;
+      SetLength(FSurface, 0);
+      SetLength(FPixels, 0);
+      FOpen := False;
+      FCloseRequest.Success := True;
+      FCloseRequest.Processed := True;
+    end;
+
+    if not FOptionRequest.Processed then
+    begin
+      FOptionRequest.Result := FConsole.Option(FOptionRequest.Option);
+      FOptionRequest.Processed := True;
+    end;
+
+    if not FGetModesRequest.Processed then
+    begin
+      FGetModesRequest.Result := FConsole.Modes;
+      FGetModesRequest.Processed := True;
+    end;
+
+    if not FMoveMouseToRequest.Processed then
+    begin
+      FMoveMouseToRequest.Result := FConsole.MoveMouseTo(FMoveMouseToRequest.X, FMoveMouseToRequest.Y);
+      FMoveMouseToRequest.Processed := True;
+    end;
+  end;
+
+begin
+  try
+    FConsole := TPTCConsoleFactory.CreateNew;
+    FConsole.Option('intercept window close');
+
+    FEventQueue := TEventQueue.Create;
+    FPalette := TPTCPaletteFactory.CreateNew;
+    FPaletteData := FPalette.Data;
+
+    FOpen := False;
+    while not Terminated do
+    begin
+      ThreadSwitch;
+      Sleep(10);
+
+      FSurfaceCriticalSection.Acquire;
+      try
+        ProcessRequests;
+
+        if FOpen then
+        begin
+          GetEvents;
+
+          if FNeedsUpdate or FPaletteNeedsUpdate then
+          begin
+            if FPaletteNeedsUpdate then
+              FSurface[FCurrentVisualPage].Palette(FPalette);
+            FSurface[FCurrentVisualPage].Copy(FConsole);
+            if FPaletteNeedsUpdate then
+              FConsole.Palette(FPalette);
+            FConsole.Update;
+
+            FNeedsUpdate := False;
+            FPaletteNeedsUpdate := False;
+          end;
+        end;
+      finally
+        FSurfaceCriticalSection.Release;
+      end;
+    end;
+
+  finally
+    FOpen := False;
+
+    FreeAndNil(FEventQueue);
+
+    if Assigned(FConsole) then
+      FConsole.Close;
+
+    SetLength(FSurface, 0);
+    FConsole := nil;
+  end;
+end;
+
+procedure TPTCWrapperThread.Open(const ATitle: string; AVirtualPages: Integer; APages: Integer = 0);
+begin
+  FSurfaceCriticalSection.Acquire;
+  try
+    with FOpenRequest do
+    begin
+      OpenType := pwotDefault;
+      Title := ATitle;
+      VirtualPages := AVirtualPages;
+      Pages := APages;
+      Processed := False;
+    end;
+  finally
+    FSurfaceCriticalSection.Release;
+  end;
+
+  repeat
+    ThreadSwitch;
+  until FOpenRequest.Processed;
+end;
+
+procedure TPTCWrapperThread.Open(const ATitle: string; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
+begin
+  FSurfaceCriticalSection.Acquire;
+  try
+    with FOpenRequest do
+    begin
+      OpenType := pwotFormat;
+      Title := ATitle;
+      Format := AFormat;
+      VirtualPages := AVirtualPages;
+      Pages := APages;
+      Processed := False;
+    end;
+  finally
+    FSurfaceCriticalSection.Release;
+  end;
+
+  repeat
+    ThreadSwitch;
+  until FOpenRequest.Processed;
+end;
+
+procedure TPTCWrapperThread.Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight, AWidth, AHeight: Integer; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
+begin
+  FSurfaceCriticalSection.Acquire;
+  try
+    with FOpenRequest do
+    begin
+      OpenType := pwotWidthHeightFormat;
+      Title := ATitle;
+      SurfaceWidth := ASurfaceWidth;
+      SurfaceHeight := ASurfaceHeight;
+      Width := AWidth;
+      Height := AHeight;
+      Format := AFormat;
+      VirtualPages := AVirtualPages;
+      Pages := APages;
+      Processed := False;
+    end;
+  finally
+    FSurfaceCriticalSection.Release;
+  end;
+
+  repeat
+    ThreadSwitch;
+  until FOpenRequest.Processed;
+end;
+
+procedure TPTCWrapperThread.Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight: Integer; AMode: IPTCMode; AVirtualPages: Integer; APages: Integer = 0);
+begin
+  FSurfaceCriticalSection.Acquire;
+  try
+    with FOpenRequest do
+    begin
+      OpenType := pwotMode;
+      Title := ATitle;
+      SurfaceWidth := ASurfaceWidth;
+      SurfaceHeight := ASurfaceHeight;
+      Mode := AMode;
+      VirtualPages := AVirtualPages;
+      Pages := APages;
+      Processed := False;
+    end;
+  finally
+    FSurfaceCriticalSection.Release;
+  end;
+
+  repeat
+    ThreadSwitch;
+  until FOpenRequest.Processed;
+end;
+
+procedure TPTCWrapperThread.Close;
+begin
+  FSurfaceCriticalSection.Acquire;
+  try
+    with FCloseRequest do
+    begin
+      Processed := False;
+    end;
+  finally
+    FSurfaceCriticalSection.Release;
+  end;
+
+  repeat
+    ThreadSwitch;
+  until FCloseRequest.Processed;
+end;
+
+function TPTCWrapperThread.Option(const AOption: string): Boolean;
+begin
+  FSurfaceCriticalSection.Acquire;
+  try
+    with FOptionRequest do
+    begin
+      Option := AOption;
+      Processed := False;
+    end;
+  finally
+    FSurfaceCriticalSection.Release;
+  end;
+
+  repeat
+    ThreadSwitch;
+  until FOptionRequest.Processed;
+  Result := FOptionRequest.Result;
+end;
+
+function TPTCWrapperThread.Modes: TPTCModeList;
+begin
+  FSurfaceCriticalSection.Acquire;
+  try
+    with FGetModesRequest do
+    begin
+      Processed := False;
+    end;
+  finally
+    FSurfaceCriticalSection.Release;
+  end;
+
+  repeat
+    ThreadSwitch;
+  until FGetModesRequest.Processed;
+  Result := FGetModesRequest.Result;
+end;
+
+procedure TPTCWrapperThread.SetVisualPage(AVisualPage: Integer);
+begin
+  FSurfaceCriticalSection.Acquire;
+  try
+    if FCurrentVisualPage <> AVisualPage then
+    begin
+      FCurrentVisualPage := AVisualPage;
+      FNeedsUpdate := True;
+      FPaletteNeedsUpdate := True;  { todo: no need to set this always }
+    end;
+  finally
+    FSurfaceCriticalSection.Release;
+  end;
+end;
+
+function TPTCWrapperThread.Lock(AVirtualPage: Integer): Pointer;
+begin
+  FSurfaceCriticalSection.Acquire;
+  if AVirtualPage = FCurrentVisualPage then
+    FNeedsUpdate := True;
+  Result := FPixels[AVirtualPage];
+end;
+
+procedure TPTCWrapperThread.Unlock;
+begin
+  FSurfaceCriticalSection.Release;
+end;
+
+function TPTCWrapperThread.PaletteLock: Pointer;
+begin
+  FSurfaceCriticalSection.Acquire;
+  FPaletteNeedsUpdate := True;
+  Result := FPaletteData;
+end;
+
+procedure TPTCWrapperThread.PaletteUnlock;
+begin
+  FSurfaceCriticalSection.Release;
+end;
+
+function TPTCWrapperThread.NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
+begin
+  repeat
+    ThreadSwitch;
+
+    FSurfaceCriticalSection.Acquire;
+    AEvent := FEventQueue.NextEvent(AEventMask);
+    FSurfaceCriticalSection.Release;
+  until (not AWait) or (AEvent <> nil);
+  Result := AEvent <> nil;
+end;
+
+function TPTCWrapperThread.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
+begin
+  repeat
+    ThreadSwitch;
+
+    FSurfaceCriticalSection.Acquire;
+    Result := FEventQueue.PeekEvent(AEventMask);
+    FSurfaceCriticalSection.Release;
+  until (not AWait) or (Result <> nil);
+end;
+
+function TPTCWrapperThread.MoveMouseTo(AX, AY: Integer): Boolean;
+begin
+  FSurfaceCriticalSection.Acquire;
+  try
+    with FMoveMouseToRequest do
+    begin
+      X := AX;
+      Y := AY;
+      Processed := False;
+    end;
+  finally
+    FSurfaceCriticalSection.Release;
+  end;
+
+  repeat
+    ThreadSwitch;
+  until FMoveMouseToRequest.Processed;
+  Result := FMoveMouseToRequest.Result;
+end;
+
+end.

packages/ptc/src/ptcwrapper/ptcwrapper_st.inc

@@ -0,0 +1,342 @@
+{
+    Free Pascal PTCPas framebuffer library single threaded wrapper
+    Copyright (C) 2010, 2011, 2012, 2013, 2019, 2021 Nikolay Nikolov ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+}
+
+unit ptcwrapper;
+
+{$MODE objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, Classes, ptc, ptceventqueue;
+
+type
+  TPTCWrapperThread = class
+  private
+    FTimer: IPTCTimer;
+    FLastUpdateTime: Real;
+    FConsole: IPTCConsole;
+    FSurface: array of IPTCSurface;
+    FPalette: IPTCPalette;
+    FNeedsUpdate: Boolean;
+    FPaletteNeedsUpdate: Boolean;
+    FCurrentVisualPage: Integer;
+
+    FEventQueue: TEventQueue;
+
+    FPixels: array of Pointer;
+    FPaletteData: Pointer;
+
+    FOpen: Boolean;
+    FLocked: Boolean;
+    FPaletteLocked: Boolean;
+    {FError?}
+
+    procedure GetEvents;
+    procedure MaybeUpdate;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure Terminate;
+    procedure WaitFor;
+
+    procedure Open(const ATitle: string; AVirtualPages: Integer; APages: Integer = 0);
+    procedure Open(const ATitle: string; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
+    procedure Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight, AWidth, AHeight: Integer; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
+    procedure Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight: Integer; AMode: IPTCMode; AVirtualPages: Integer; APages: Integer = 0);
+    procedure Close;
+
+    function Option(const AOption: string): Boolean;
+
+    function Modes: TPTCModeList;
+
+    procedure SetVisualPage(AVisualPage: Integer);
+
+    function Lock(AVirtualPage: Integer): Pointer;
+    procedure Unlock;
+
+    function PaletteLock: Pointer;
+    procedure PaletteUnlock;
+
+    function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
+    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
+
+    function MoveMouseTo(AX, AY: Integer): Boolean;
+
+    property IsOpen: Boolean read FOpen;
+  end;
+
+implementation
+
+constructor TPTCWrapperThread.Create;
+begin
+  FOpen := False;
+  FNeedsUpdate := False;
+
+  FTimer := TPTCTimerFactory.CreateNew;
+  FTimer.Start;
+  FLastUpdateTime := -1000;
+
+  FConsole := TPTCConsoleFactory.CreateNew;
+  FConsole.Option('intercept window close');
+
+  FEventQueue := TEventQueue.Create;
+  FPalette := TPTCPaletteFactory.CreateNew;
+  FPaletteData := FPalette.Data;
+
+  FOpen := False;
+
+  inherited Create;
+end;
+
+destructor TPTCWrapperThread.Destroy;
+begin
+  FOpen := False;
+
+  FreeAndNil(FEventQueue);
+
+  if Assigned(FConsole) then
+    FConsole.Close;
+
+  SetLength(FSurface, 0);
+  FConsole := nil;
+
+  inherited;
+end;
+
+procedure TPTCWrapperThread.GetEvents;
+var
+  Event: IPTCEvent;
+  NextEventAvailable: Boolean;
+begin
+  repeat
+    NextEventAvailable := FConsole.NextEvent(Event, False, PTCAnyEvent);
+    if NextEventAvailable then
+      FEventQueue.AddEvent(Event);
+  until not NextEventAvailable;
+end;
+
+procedure TPTCWrapperThread.MaybeUpdate;
+const
+  MinFrameTime = 1/60;
+begin
+  if FOpen then
+  begin
+    GetEvents;
+
+    if (not FLocked) and (not FPaletteLocked) and (FNeedsUpdate or FPaletteNeedsUpdate) and
+       ((FTimer.Time - FLastUpdateTime) > MinFrameTime) then
+    begin
+      if FPaletteNeedsUpdate then
+        FSurface[FCurrentVisualPage].Palette(FPalette);
+      FSurface[FCurrentVisualPage].Copy(FConsole);
+      if FPaletteNeedsUpdate then
+        FConsole.Palette(FPalette);
+      FConsole.Update;
+
+      FNeedsUpdate := False;
+      FPaletteNeedsUpdate := False;
+
+      FLastUpdateTime := FTimer.Time;
+    end;
+  end;
+end;
+
+procedure TPTCWrapperThread.Open(const ATitle: string; AVirtualPages: Integer; APages: Integer = 0);
+var
+  I: Integer;
+begin
+  SetLength(FSurface, AVirtualPages);
+  for I := Low(FSurface) to High(FSurface) do
+    FSurface[I] := nil;
+  FConsole.Open(ATitle, APages);
+  for I := Low(FSurface) to High(FSurface) do
+    FSurface[I] := TPTCSurfaceFactory.CreateNew(FConsole.Width, FConsole.Height, FConsole.Format);
+  SetLength(FPixels, Length(FSurface));
+  for I := Low(FSurface) to High(FSurface) do
+  begin
+    FPixels[I] := FSurface[I].Lock;
+    FSurface[I].Unlock;
+  end;
+  FOpen := True;
+end;
+
+procedure TPTCWrapperThread.Open(const ATitle: string; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
+var
+  I: Integer;
+begin
+  SetLength(FSurface, AVirtualPages);
+  for I := Low(FSurface) to High(FSurface) do
+    FSurface[I] := nil;
+  FConsole.Open(ATitle, AFormat, APages);
+  for I := Low(FSurface) to High(FSurface) do
+    FSurface[I] := TPTCSurfaceFactory.CreateNew(FConsole.Width, FConsole.Height, AFormat);
+  SetLength(FPixels, Length(FSurface));
+  for I := Low(FSurface) to High(FSurface) do
+  begin
+    FPixels[I] := FSurface[I].Lock;
+    FSurface[I].Unlock;
+  end;
+  FOpen := True;
+end;
+
+procedure TPTCWrapperThread.Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight, AWidth, AHeight: Integer; AFormat: IPTCFormat; AVirtualPages: Integer; APages: Integer = 0);
+var
+  I: Integer;
+begin
+  SetLength(FSurface, AVirtualPages);
+  for I := Low(FSurface) to High(FSurface) do
+    FSurface[I] := nil;
+  FConsole.Open(ATitle, AWidth, AHeight, AFormat, APages);
+  for I := Low(FSurface) to High(FSurface) do
+    FSurface[I] := TPTCSurfaceFactory.CreateNew(ASurfaceWidth, ASurfaceHeight, AFormat);
+  SetLength(FPixels, Length(FSurface));
+  for I := Low(FSurface) to High(FSurface) do
+  begin
+    FPixels[I] := FSurface[I].Lock;
+    FSurface[I].Unlock;
+  end;
+  FOpen := True;
+end;
+
+procedure TPTCWrapperThread.Open(const ATitle: string; ASurfaceWidth, ASurfaceHeight: Integer; AMode: IPTCMode; AVirtualPages: Integer; APages: Integer = 0);
+var
+  I: Integer;
+begin
+  SetLength(FSurface, AVirtualPages);
+  for I := Low(FSurface) to High(FSurface) do
+    FSurface[I] := nil;
+  FConsole.Open(ATitle, AMode, APages);
+  for I := Low(FSurface) to High(FSurface) do
+    FSurface[I] := TPTCSurfaceFactory.CreateNew(ASurfaceWidth, ASurfaceHeight, AMode.Format);
+  SetLength(FPixels, Length(FSurface));
+  for I := Low(FSurface) to High(FSurface) do
+  begin
+    FPixels[I] := FSurface[I].Lock;
+    FSurface[I].Unlock;
+  end;
+  FOpen := True;
+end;
+
+procedure TPTCWrapperThread.Close;
+var
+  I: Integer;
+begin
+  FConsole.Close;
+  for I := Low(FSurface) to High(FSurface) do
+    FSurface[I] := nil;
+  SetLength(FSurface, 0);
+  SetLength(FPixels, 0);
+  FOpen := False;
+end;
+
+function TPTCWrapperThread.Option(const AOption: string): Boolean;
+begin
+  Result := FConsole.Option(AOption);
+end;
+
+function TPTCWrapperThread.Modes: TPTCModeList;
+begin
+  Result := FConsole.Modes;
+end;
+
+procedure TPTCWrapperThread.SetVisualPage(AVisualPage: Integer);
+begin
+  if FCurrentVisualPage <> AVisualPage then
+  begin
+    FCurrentVisualPage := AVisualPage;
+    FNeedsUpdate := True;
+    FPaletteNeedsUpdate := True;  { todo: no need to set this always }
+  end;
+  MaybeUpdate;
+end;
+
+function TPTCWrapperThread.Lock(AVirtualPage: Integer): Pointer;
+begin
+  FLocked := True;
+  if AVirtualPage = FCurrentVisualPage then
+    FNeedsUpdate := True;
+  Result := FPixels[AVirtualPage];
+end;
+
+procedure TPTCWrapperThread.Unlock;
+begin
+  FLocked := False;
+  MaybeUpdate;
+end;
+
+function TPTCWrapperThread.PaletteLock: Pointer;
+begin
+  FPaletteLocked := True;
+  FPaletteNeedsUpdate := True;
+  Result := FPaletteData;
+end;
+
+procedure TPTCWrapperThread.PaletteUnlock;
+begin
+  FPaletteLocked := False;
+  MaybeUpdate;
+end;
+
+function TPTCWrapperThread.NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
+begin
+  repeat
+    MaybeUpdate;
+
+    AEvent := FEventQueue.NextEvent(AEventMask);
+  until (not AWait) or (AEvent <> nil);
+  Result := AEvent <> nil;
+end;
+
+function TPTCWrapperThread.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
+begin
+  repeat
+    MaybeUpdate;
+
+    Result := FEventQueue.PeekEvent(AEventMask);
+  until (not AWait) or (Result <> nil);
+end;
+
+function TPTCWrapperThread.MoveMouseTo(AX, AY: Integer): Boolean;
+begin
+  Result := FConsole.MoveMouseTo(AX, AY);
+end;
+
+procedure TPTCWrapperThread.Terminate;
+begin
+end;
+
+procedure TPTCWrapperThread.WaitFor;
+begin
+end;
+
+end.

packages/ptc/src/x11/x11windowdisplayi.inc

@@ -373,7 +373,8 @@ begin
                                   StructureNotifyMask or FocusChangeMask or
                                   ButtonPressMask or ButtonReleaseMask or
                                   PointerMotionMask or ExposureMask or
-                                  EnterWindowMask or LeaveWindowMask or im_event_mask);
+                                  EnterWindowMask or LeaveWindowMask or
+                                  MappingNotify or im_event_mask);
   XSync(FDisplay, False);
 
 {$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
@@ -957,6 +958,7 @@ begin
         exit;
     end;
     case e._type of
+      MappingNotify: XRefreshKeyboardMapping(@e);
       FocusIn: begin
         NewFocus := True;
         NewFocusSpecified := True;