Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
fpc-src / usr / share / fpcsrc / 3.0.0 / packages / ptc / src / x11 / x11windowdisplayi.inc
Size: Mime:
{
    This file is part of the PTCPas framebuffer library
    Copyright (C) 2001-2013 Nikolay Nikolov (nickysn@users.sourceforge.net)
    Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)

    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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

constructor TX11WindowDisplay.Create(ADisplay: PDisplay; AScreen: Integer; const AFlags: TX11Flags);
begin
  inherited;
  FFocus := True;
  FX11InvisibleCursor := None;
  FCursorVisible := True;
  FGrabMouse := False;
  FMouseGrabbed := False;
end;

destructor TX11WindowDisplay.Destroy;
begin
  Close;
  inherited Destroy;
end;

procedure TX11WindowDisplay.Open(ATitle: AnsiString; AWidth, AHeight: Integer; AFormat: IPTCFormat; const AOpenGLAttributes: IPTCOpenGLAttributes);
var
  xgcv: TXGCValues;
  textprop: TXTextProperty;
  e: TXEvent;
  found: Boolean;
  attr: TXSetWindowAttributes;
  AttrMask: culong;
  size_hints: PXSizeHints;
  tmppchar: PChar;
  tmpArrayOfCLong: array [1..1] of clong;
  tmpPixmap: TPixmap;
  BlackColor: TXColor;
  BlankCursorData: array [1..8] of Byte = (0, 0, 0, 0, 0, 0, 0, 0);
  CreateWindow_Depth: cint;
  CreateWindow_Visual: PVisual;
begin
  FHeight := AHeight;
  FWidth := AWidth;
  FPreviousWidth := FWidth;
  FPreviousHeight := FHeight;
  FDestX := 0;
  FDestY := 0;

  FFullScreen := PTC_X11_FULLSCREEN in FFlags;
  FResizable := (PTC_X11_RESIZABLE_WINDOW in FFlags) and not FFullScreen;

  FFocus := True;

  FPreviousMousePositionSaved := False;

  FillChar(BlackColor, SizeOf(BlackColor), 0);
  BlackColor.red := 0;
  BlackColor.green := 0;
  BlackColor.blue := 0;

  { Create the mode switcher object }
  if (FModeSwitcher = Nil) and FFullScreen then
    FModeSwitcher := CreateModeSwitcher;

  { Create the invisible cursor }
  tmpPixmap := XCreateBitmapFromData(FDisplay, RootWindow(FDisplay, FScreen), @BlankCursorData, 8, 8);
  try
    FX11InvisibleCursor := XCreatePixmapCursor(FDisplay, tmpPixmap, tmpPixmap, @BlackColor, @BlackColor, 0, 0);
  finally
    if tmpPixmap <> None then
      XFreePixmap(FDisplay, tmpPixmap);
  end;

  { Check if we have that colour depth available.. Easy as there is no
    format conversion yet }
  FFormat := GetX11Format(AFormat);

  attr.border_pixel := BlackPixel(FDisplay, FScreen);
  attr.background_pixel := BlackPixel(FDisplay, FScreen);
  AttrMask := CWBackPixel or CWBorderPixel;

  CreateWindow_Depth := CopyFromParent;
  CreateWindow_Visual := PVisual(CopyFromParent);
  FVisual := DefaultVisual(FDisplay, FScreen);

  if PTC_X11_USE_OPENGL in FFlags then
  begin
{$IFDEF ENABLE_X11_EXTENSION_GLX}
    FGLXFBConfig := TX11GLXFBConfig.Create(FDisplay, FScreen, AOpenGLAttributes);
    CreateWindow_Depth := FGLXFBConfig.FVisInfo.depth;
    CreateWindow_Visual := FGLXFBConfig.FVisInfo.visual;
    FVisual := CreateWindow_Visual;
    FScreen := FGLXFBConfig.FVisInfo.screen; //?
    attr.colormap := XCreateColormap(FDisplay, RootWindow(FDisplay, FScreen), CreateWindow_Visual, AllocNone);
    AttrMask := AttrMask or CWColormap;
{$ELSE ENABLE_X11_EXTENSION_GLX}
    raise TPTCError.Create('Console does not support OpenGL');
{$ENDIF ENABLE_X11_EXTENSION_GLX}
  end;

  { Create a window }
  FWindow := XCreateWindow(FDisplay, RootWindow(FDisplay, FScreen), 0, 0,
                AWidth, AHeight, 0, CreateWindow_Depth, InputOutput, CreateWindow_Visual,
                AttrMask, @attr);
  { Register the delete atom }
  FAtomClose := XInternAtom(FDisplay, 'WM_DELETE_WINDOW', False);
  X11Check(XSetWMProtocols(FDisplay, FWindow, @FAtomClose, 1), 'XSetWMProtocols');

  if not (PTC_X11_USE_OPENGL in FFlags) then
  begin
    { Get graphics context }
    xgcv.graphics_exposures := Ord(False);
    FGC := XCreateGC(FDisplay, FWindow, GCGraphicsExposures, @xgcv);
    if FGC = nil then
      raise TPTCError.Create('can''t create graphics context');
  end;

  { Set window title }
  tmppchar := PChar(ATitle);
  X11Check(XStringListToTextProperty(@tmppchar, 1, @textprop), 'XStringListToTextProperty');
  try
    XSetWMName(FDisplay, FWindow, @textprop);
    XFlush(FDisplay);
  finally
    XFree(textprop.value);
  end;

  { Set normal hints }
  size_hints := XAllocSizeHints;
  try
    size_hints^.flags := PBaseSize;
    size_hints^.base_width := AWidth;
    size_hints^.base_height := AHeight;
    if FFullScreen then
    begin
      size_hints^.flags := size_hints^.flags or PMinSize or PWinGravity;
      size_hints^.min_width := AWidth;
      size_hints^.min_height := AHeight;
      size_hints^.win_gravity := StaticGravity;
    end
    else
    begin
      if FResizable then
      begin
        size_hints^.flags := size_hints^.flags or PMinSize;
        size_hints^.min_width := 0;
        size_hints^.min_height := 0;
      end
      else
      begin
        { not fullscreen and not resizable: maxsize=minsize=basesize }
        size_hints^.flags := size_hints^.flags or PMinSize or PMaxSize;
        size_hints^.min_width := AWidth;
        size_hints^.min_height := AHeight;
        size_hints^.max_width := AWidth;
        size_hints^.max_height := AHeight;
      end;
    end;
    XSetWMNormalHints(FDisplay, FWindow, size_hints);
    XFlush(FDisplay);
  finally
    XFree(size_hints);
  end;

  { Set the _NET_WM_STATE property }
  if FFullScreen then
  begin
    tmpArrayOfCLong[1] := XInternAtom(FDisplay, '_NET_WM_STATE_FULLSCREEN', False);

    XChangeProperty(FDisplay, FWindow,
                    XInternAtom(FDisplay, '_NET_WM_STATE', False),
                    XA_ATOM,
                    32, PropModeReplace, @tmpArrayOfCLong, 1);
  end;

  { Map the window and wait for success }
  XSelectInput(FDisplay, FWindow, StructureNotifyMask);
  XMapRaised(FDisplay, FWindow);
  repeat
    XNextEvent(FDisplay, @e);
    if e._type = MapNotify then
      Break;
  until False;
  { Get keyboard input and sync }
  XSelectInput(FDisplay, FWindow, KeyPressMask or KeyReleaseMask or
                                  StructureNotifyMask or FocusChangeMask or
                                  ButtonPressMask or ButtonReleaseMask or
                                  PointerMotionMask or ExposureMask);
  XSync(FDisplay, False);

  if not (PTC_X11_USE_OPENGL in FFlags) then
  begin
    { Create XImage using factory method }
    FPrimary := CreateImage(FDisplay, FScreen, FWidth, FHeight, FFormat);
  end;

  found := False;
  repeat
    { Stupid loop. The key }
    { events were causing }
    { problems.. }
    found := XCheckMaskEvent(FDisplay, KeyPressMask or KeyReleaseMask, @e);
  until not found;

  attr.backing_store := Always;
  XChangeWindowAttributes(FDisplay, FWindow, CWBackingStore, @attr);

  { Set clipping area }
  FClip := TPTCArea.Create(0, 0, FWidth, FHeight);

  { Installs the right colour map for 8 bit modes }
  CreateColormap;

{$IFDEF ENABLE_X11_EXTENSION_GLX}
  if PTC_X11_USE_OPENGL in FFlags then
  begin
    FGLXFBConfig.AttachToWindow(FWindow);
    FGLXFBConfig.MakeRenderingContextCurrent;
  end;
{$ENDIF ENABLE_X11_EXTENSION_GLX}

  if FFullScreen then
    EnterFullScreen;

  FOpen := True;
end;

procedure TX11WindowDisplay.Open(AWindow: TWindow; AFormat: IPTCFormat);
begin
end;

procedure TX11WindowDisplay.Open(AWindow: TWindow; AFormat: IPTCFormat; AX, AY, AWidth, AHeight: Integer);
begin
end;

procedure TX11WindowDisplay.Close;
begin
  FOpen := False;

  FreeAndNil(FModeSwitcher);

{$IFDEF ENABLE_X11_EXTENSION_GLX}
  FreeAndNil(FGLXFBConfig);
{$ENDIF ENABLE_X11_EXTENSION_GLX}

  {pthreads?!}
  if FCMap <> 0 then
  begin
    XFreeColormap(FDisplay, FCMap);
    FCMap := 0;
  end;

  { Destroy XImage and buffer }
  FreeAndNil(FPrimary);
  FreeMemAndNil(FColours);

  if FGC <> nil then
  begin
    XFreeGC(FDisplay, FGC);
    FGC := nil;
  end;

  { Hide and destroy window }
  if (FWindow <> 0) and (not (PTC_X11_LEAVE_WINDOW In FFlags)) then
  begin
    XUnmapWindow(FDisplay, FWindow);
    XSync(FDisplay, False);

    XDestroyWindow(FDisplay, FWindow);
  end;

  { Free the invisible cursor }
  if FX11InvisibleCursor <> None then
  begin
    XFreeCursor(FDisplay, FX11InvisibleCursor);
    FX11InvisibleCursor := None;
  end;
end;

procedure TX11WindowDisplay.InternalResize(AWidth, AHeight: Integer);
begin
  if FFullScreen then
    raise TPTCError.Create('Internal resize not supported in fullscreen mode');
  if not FResizable then
    raise TPTCError.Create('Internal resize cannot be used on a non-resizable window');

  if not (PTC_X11_USE_OPENGL in FFlags) then
  begin
    { destroy previous XImage }
    FreeAndNil(FPrimary);
  end;

  FWidth := AWidth;
  FHeight := AHeight;

  if not (PTC_X11_USE_OPENGL in FFlags) then
  begin
    { Create XImage using factory method }
    FPrimary := CreateImage(FDisplay, FScreen, FWidth, FHeight, FFormat);
  end;

  { Set clipping area }
  FClip := TPTCArea.Create(0, 0, FWidth, FHeight);
end;

procedure TX11WindowDisplay.internal_ShowCursor(AVisible: Boolean);
var
  attr: TXSetWindowAttributes;
begin
  if AVisible then
    attr.cursor := None { Use the normal cursor }
  else
    attr.cursor := FX11InvisibleCursor; { Set the invisible cursor }

  XChangeWindowAttributes(FDisplay, FWindow, CWCursor, @attr);
end;

procedure TX11WindowDisplay.internal_GrabMouse(AGrabMouse: Boolean);
var
  GrabResult: cint;
begin
  if AGrabMouse then
  begin
    if not FMouseGrabbed then
    begin
      //Writeln('XGrabPointer...');
      GrabResult :=XGrabPointer(FDisplay, FWindow, True,
                                PointerMotionMask or ButtonPressMask or ButtonReleaseMask,
                                GrabModeAsync, GrabModeAsync,
                                FWindow, None, CurrentTime);
      if GrabResult <> GrabSuccess then
      begin
        LOG('XGrabPointer failed, result=' + IntToStr(GrabResult));
        //Writeln(GrabResult);
      end;

      { XGrabPointer may fail if someone else is already holding a mouse grab.
        It happens e.g. sometimes when alt+tabbing away and back to the application
        in GNOME. That's why we check the result and try again on the next call.
        And that's why this method is called everytime HandleEvents is called. }
      FMouseGrabbed := GrabResult = GrabSuccess;
    end;
  end
  else
  begin
    if FMouseGrabbed then
    begin
      //Writeln('XUngrabPointer');
      XUngrabPointer(FDisplay, CurrentTime);
      FMouseGrabbed := False;
    end;
  end;
end;

procedure TX11WindowDisplay.SetCursor(AVisible: Boolean);
begin
  FCursorVisible := AVisible;

  if FFocus then
    internal_ShowCursor(FCursorVisible);
end;

procedure TX11WindowDisplay.SetMouseGrab(AGrabMouse: Boolean);
begin
  FGrabMouse := AGrabMouse;

  if FFocus then
    internal_GrabMouse(FGrabMouse);
end;

procedure TX11WindowDisplay.EnterFullScreen;
begin
  { try to switch mode }
  if Assigned(FModeSwitcher) then
    FModeSwitcher.SetBestMode(FWidth, FHeight);

  XSync(FDisplay, False);

  { Center the image }
  FDestX := FModeSwitcher.Width div 2 - FWidth div 2;
  FDestY := FModeSwitcher.Height div 2 - FHeight div 2;
end;

procedure TX11WindowDisplay.LeaveFullScreen;
begin
  { Restore previous mode }
  if Assigned(FModeSwitcher) then
    FModeSwitcher.RestorePreviousMode;

  XSync(FDisplay, False);
end;

procedure TX11WindowDisplay.HandleChangeFocus(ANewFocus: Boolean);
begin
  { No change? }
  if ANewFocus = FFocus then
    exit;

  FFocus := ANewFocus;
  if FFocus then
  begin
    { focus in }
    if FFullScreen then
      EnterFullScreen;

    internal_ShowCursor(FCursorVisible);
//    internal_GrabMouse(FGrabMouse);
  end
  else
  begin
    { focus out }

    internal_GrabMouse(False);

    if FFullScreen then
      LeaveFullScreen;

    internal_ShowCursor(True);
  end;

  XSync(FDisplay, False);
end;

function TX11WindowDisplay_MatchAnyEvent(display: PDisplay; event: PXEvent; arg: TXPointer): LongBool; cdecl;
begin
  Result := LongBool(1);
end;

procedure TX11WindowDisplay.HandleEvents;
var
  e: TXEvent;
  NewFocus: Boolean;
  NewFocusSpecified: Boolean;

  function UsefulEventsPending: Boolean;
  var
    tmpEvent: TXEvent;
  begin
    if XCheckIfEvent(FDisplay, @tmpEvent, @TX11WindowDisplay_MatchAnyEvent, nil) then
    begin
      Result := True;
      XPutBackEvent(FDisplay, @tmpEvent);
      exit;
    end;

    Result := False;
  end;

  procedure HandleMouseEvent;
  var
    x, y: cint;
    state: cuint;
    PTCMouseButtonState: TPTCMouseButtonState;

    button: TPTCMouseButton;
    before, after: Boolean;
    cstate: TPTCMouseButtonState;
  begin
    case e._type of
      MotionNotify: begin
        x := e.xmotion.x;
        y := e.xmotion.y;
        state := e.xmotion.state;
      end;
      ButtonPress, ButtonRelease: begin
        x := e.xbutton.x;
        y := e.xbutton.y;
        state := e.xbutton.state;
        if e._type = ButtonPress then
        begin
          case e.xbutton.button of
            Button1: state := state or Button1Mask;
            Button2: state := state or Button2Mask;
            Button3: state := state or Button3Mask;
            Button4: state := state or Button4Mask;
            Button5: state := state or Button5Mask;
          end;
        end
        else
        begin
          case e.xbutton.button of
            Button1: state := state and (not Button1Mask);
            Button2: state := state and (not Button2Mask);
            Button3: state := state and (not Button3Mask);
            Button4: state := state and (not Button4Mask);
            Button5: state := state and (not Button5Mask);
          end;
        end;
      end;
      else
        raise TPTCError.Create('Internal Error');
    end;

    if (state and Button1Mask) = 0 then
      PTCMouseButtonState := []
    else
      PTCMouseButtonState := [PTCMouseButton1];
    if (state and Button2Mask) <> 0 then
      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2];
    if (state and Button3Mask) <> 0 then
      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3];
    if (state and Button4Mask) <> 0 then
      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton4];
    if (state and Button5Mask) <> 0 then
      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton5];

    if (x >= 0) and (x < FWidth) and (y >= 0) and (y < FHeight) then
    begin
      if not FPreviousMousePositionSaved then
      begin
        FPreviousMouseX := x; { first DeltaX will be 0 }
        FPreviousMouseY := y; { first DeltaY will be 0 }
        FPreviousMouseButtonState := [];
      end;

      { movement? }
      if (x <> FPreviousMouseX) or (y <> FPreviousMouseY) then
        FEventQueue.AddEvent(TPTCMouseEvent.Create(x, y, x - FPreviousMouseX, y - FPreviousMouseY, FPreviousMouseButtonState));

      { button presses/releases? }
      cstate := FPreviousMouseButtonState;
      for button := Low(button) to High(button) do
      begin
        before := button In FPreviousMouseButtonState;
        after := button In PTCMouseButtonState;
        if after and (not before) then
        begin
          { button was pressed }
          cstate := cstate + [button];
          FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(x, y, 0, 0, cstate, True, button));
        end
        else
          if before and (not after) then
          begin
            { button was released }
            cstate := cstate - [button];
            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(x, y, 0, 0, cstate, False, button));
          end;
      end;

      FPreviousMouseX := x;
      FPreviousMouseY := y;
      FPreviousMouseButtonState := PTCMouseButtonState;
      FPreviousMousePositionSaved := True;
    end;
  end;

  procedure HandleConfigureNotifyEvent;
  begin
    if FFullScreen or not FResizable then
      exit;

    if (FPreviousWidth <> e.xconfigure.width) or (FPreviousHeight <> e.xconfigure.height) then
      FEventQueue.AddEvent(TPTCResizeEvent.Create(e.xconfigure.width, e.xconfigure.height));

    FPreviousWidth := e.xconfigure.width;
    FPreviousHeight := e.xconfigure.height;
  end;

begin
  NewFocusSpecified := False;
  while UsefulEventsPending do
  begin
    XNextEvent(FDisplay, @e);
    case e._type of
      FocusIn: begin
        NewFocus := True;
        NewFocusSpecified := True;
      end;
      FocusOut: begin
        NewFocus := False;
        NewFocusSpecified := True;
      end;
      ClientMessage: begin
        if (e.xclient.format = 32) and (TAtom(e.xclient.data.l[0]) = FAtomClose) then
          if InterceptClose then
            FEventQueue.AddEvent(TPTCCloseEvent.Create)
          else
            Halt(0);
      end;
      Expose: begin
        if e.xexpose.count = 0 then
          Draw;
      end;
      ConfigureNotify: HandleConfigureNotifyEvent;
      KeyPress, KeyRelease: HandleKeyEvent(e.xkey);
      ButtonPress, ButtonRelease, MotionNotify: HandleMouseEvent;
    end;
  end;
  if NewFocusSpecified then
    HandleChangeFocus(NewFocus);

  if FFocus then
    internal_GrabMouse(FGrabMouse);
end;

procedure TX11WindowDisplay.Draw;
begin
  if not (PTC_X11_USE_OPENGL in FFlags) then
  begin
    FPrimary.Put(FWindow, FGC, FDestX, FDestY);
  end;
end;

procedure TX11WindowDisplay.Update;
begin
  Draw;

  HandleEvents;
end;

procedure TX11WindowDisplay.Update(AArea: IPTCArea);
var
  UpdateArea: IPTCArea;
begin
  UpdateArea := TPTCClipper.Clip(TPTCArea.Create(0, 0, FWidth, FHeight), AArea);
  FPrimary.Put(FWindow, FGC, UpdateArea.Left, UpdateArea.Top,
               FDestX + UpdateArea.Left, FDestY + UpdateArea.Top,
               UpdateArea.Width, UpdateArea.Height);

  HandleEvents;
end;

function TX11WindowDisplay.NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
var
  tmpEvent: TXEvent;
begin
  repeat
    { process all events from the X queue and put them on our FEventQueue }
    HandleEvents;

    { try to find an event that matches the EventMask }
    AEvent := FEventQueue.NextEvent(AEventMask);

    if AWait and (AEvent = Nil) then
    begin
      { if the X event queue is empty, block until an event is received }
      XPeekEvent(FDisplay, @tmpEvent);
    end;
  until (not AWait) or (AEvent <> Nil);
  Result := AEvent <> nil;
end;

function TX11WindowDisplay.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
var
  tmpEvent: TXEvent;
begin
  repeat
    { process all events from the X queue and put them on our FEventQueue }
    HandleEvents;

    { try to find an event that matches the EventMask }
    Result := FEventQueue.PeekEvent(AEventMask);

    if AWait and (Result = Nil) then
    begin
      { if the X event queue is empty, block until an event is received }
      XPeekEvent(FDisplay, @tmpEvent);
    end;
  until (not AWait) or (Result <> nil);
end;

function TX11WindowDisplay.Lock: Pointer;
begin
  Result := FPrimary.Lock;
end;

procedure TX11WindowDisplay.Unlock;
begin
end;

procedure TX11WindowDisplay.GetModes(var AModes: TPTCModeList);
var
  current_desktop_format: IPTCFormat;
begin
  if FModeSwitcher = nil then
    FModeSwitcher := CreateModeSwitcher;

  current_desktop_format := GetX11Format(TPTCFormat.Create(8));

  FModeSwitcher.GetModes(AModes, current_desktop_format);
end;

procedure TX11WindowDisplay.Palette(APalette: IPTCPalette);
var
  pal: PUint32;
  i: Integer;
begin
  pal := APalette.Data;
  if not FFormat.Indexed then
    exit;
  for i := 0 to 255 do
  begin
    FColours[i].pixel := i;

    FColours[i].red := ((pal[i] shr 16) and $FF) shl 8;
    FColours[i].green := ((pal[i] shr 8) and $FF) shl 8;
    FColours[i].blue := (pal[i] and $FF) shl 8;

    Byte(FColours[i].flags) := DoRed or DoGreen or DoBlue;
  end;
  XStoreColors(FDisplay, FCMap, FColours, 256);
end;

function TX11WindowDisplay.GetPitch: Integer;
begin
  Result := FPrimary.Pitch;
end;

function TX11WindowDisplay.CreateImage(ADisplay: PDisplay; AScreen, AWidth, AHeight: Integer;
                                       AFormat: IPTCFormat): TX11Image;
begin
  {$IFDEF ENABLE_X11_EXTENSION_XSHM}
  if (PTC_X11_TRY_XSHM In FFlags) and XShmQueryExtension(ADisplay) then
  begin
    try
      LOG('trying to create a XShm image');
      Result := TX11ShmImage.Create(ADisplay, AScreen, AWidth, AHeight, AFormat);
      exit;
    except
      LOG('XShm failed');
    end;
  end;
  {$ENDIF ENABLE_X11_EXTENSION_XSHM}

  LOG('trying to create a normal image');
  Result := TX11NormalImage.Create(ADisplay, AScreen, AWidth, AHeight, AFormat);
end;

function TX11WindowDisplay.CreateModeSwitcher: TX11Modes;
begin
{$IFDEF ENABLE_X11_EXTENSION_XRANDR}
  if PTC_X11_TRY_XRANDR in FFlags then
    try
      LOG('trying to initialize the Xrandr mode switcher');
      Result := TX11ModesXrandr.Create(FDisplay, FScreen);
      exit;
    except
      LOG('Xrandr failed');
    end;
{$ENDIF ENABLE_X11_EXTENSION_XRANDR}

{$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE}
  if PTC_X11_TRY_XF86VIDMODE in FFlags then
    try
      LOG('trying to initialize the XF86VidMode mode switcher');
      Result := TX11ModesXF86VidMode.Create(FDisplay, FScreen);
      exit;
    except
      LOG('XF86VidMode failed');
    end;
{$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE}

  LOG('creating the standard NoModeSwitching mode switcher');
  Result := TX11ModesNoModeSwitching.Create(FDisplay, FScreen);
end;

function TX11WindowDisplay.GetX11Window: TWindow;
begin
  Result := FWindow;
end;

function TX11WindowDisplay.GetX11GC: TGC;
begin
  Result := FGC;
end;

function TX11WindowDisplay.IsFullScreen: Boolean;
begin
  Result := FFullScreen;
end;

function TX11WindowDisplay.IsOpen: Boolean;
begin
  Result := FOpen;
end;

procedure TX11WindowDisplay.CreateColormap; { Register colour maps }
var
  i: Integer;
  r, g, b: Single;
begin
  if FFormat.Bits = 8 then
  begin
    FColours := GetMem(256 * SizeOf(TXColor));
    if FColours = nil then
      raise TPTCError.Create('Cannot allocate colour map cells');
    FCMap := XCreateColormap(FDisplay, RootWindow(FDisplay, FScreen),
                             DefaultVisual(FDisplay, FScreen), AllocAll);
    if FCMap = 0 then
      raise TPTCError.Create('Cannot create colour map');
    XInstallColormap(FDisplay, FCMap);
    XSetWindowColormap(FDisplay, FWindow, FCMap);
  end
  else
    FCMap := 0;

  { Set 332 palette, for now }
  if (FFormat.Bits = 8) and FFormat.Direct then
  begin
    {Taken from PTC 0.72, i hope it's fine}
    for i := 0 to 255 do
    begin
      r := ((i and $E0) shr 5) * 255 / 7;
      g := ((i and $1C) shr 2) * 255 / 7;
      b := (i and $03) * 255 / 3;

      FColours[i].pixel := i;

      FColours[i].red := Round(r) shl 8;
      FColours[i].green := Round(g) shl 8;
      FColours[i].blue := Round(b) shl 8;

      Byte(FColours[i].flags) := DoRed or DoGreen or DoBlue;
    end;
    XStoreColors(FDisplay, FCMap, FColours, 256);
  end;
end;

{$IFDEF ENABLE_X11_EXTENSION_GLX}
procedure TX11WindowDisplay.OpenGL_SwapBuffers;
begin
  FGLXFBConfig.SwapBuffers;
end;

procedure TX11WindowDisplay.OpenGL_SetSwapInterval(AInterval: Integer);
begin
  FGLXFBConfig.SetSwapInterval(AInterval);
end;

function TX11WindowDisplay.OpenGL_GetSwapInterval: Integer;
begin
  Result := FGLXFBConfig.GetSwapInterval;
end;
{$ENDIF ENABLE_X11_EXTENSION_GLX}