diff options
Diffstat (limited to 'packages/ptc/src/x11')
20 files changed, 4426 insertions, 0 deletions
diff --git a/packages/ptc/src/x11/check.inc b/packages/ptc/src/x11/check.inc new file mode 100644 index 0000000000..52f20ef718 --- /dev/null +++ b/packages/ptc/src/x11/check.inc @@ -0,0 +1,63 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + 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. + + 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 +} + +Procedure X11Check(result : TStatus); + +{Var + ErrStr : String;} + +Begin + {todo: fix X11 error handling} +{ If result = Success Then + Exit; + Case result Of + BadRequest : ErrStr := 'BadRequest'; + BadValue : ErrStr := 'BadValue'; + BadWindow : ErrStr := 'BadWindow'; + BadPixmap : ErrStr := 'BadPixmap'; + BadAtom : ErrStr := 'BadAtom'; + BadCursor : ErrStr := 'BadCursor'; + BadFont : ErrStr := 'BadFont'; + BadMatch : ErrStr := 'BadMatch'; + BadDrawable : ErrStr := 'BadDrawable'; + BadAccess : ErrStr := 'BadAccess'; + BadAlloc : ErrStr := 'BadAlloc'; + BadColor : ErrStr := 'BadColor'; + BadGC : ErrStr := 'BadGC'; + BadIDChoice : ErrStr := 'BadIDChoice'; + BadName : ErrStr := 'BadName'; + BadLength : ErrStr := 'BadLength'; + BadImplementation : ErrStr := 'BadImplementation'; + Else + Str(result, ErrStr); + End; + Raise TPTCError.Create('X11 Error: ' + ErrStr);} +End; + +Procedure X11Check(result : TStatus; Const message : String); + +Begin + Try + X11Check(result); + Except + On error : TPTCError Do + Raise TPTCError.Create(message, error); + End; +End; diff --git a/packages/ptc/src/x11/extensions.inc b/packages/ptc/src/x11/extensions.inc new file mode 100644 index 0000000000..9ecfbff4d8 --- /dev/null +++ b/packages/ptc/src/x11/extensions.inc @@ -0,0 +1,6 @@ +{ X11 extensions we want to enable at compile time } +{$DEFINE ENABLE_X11_EXTENSION_XRANDR} +{$DEFINE ENABLE_X11_EXTENSION_XF86VIDMODE} +{$DEFINE ENABLE_X11_EXTENSION_XF86DGA1} +{$DEFINE ENABLE_X11_EXTENSION_XF86DGA2} +{$DEFINE ENABLE_X11_EXTENSION_XSHM} diff --git a/packages/ptc/src/x11/includes.inc b/packages/ptc/src/x11/includes.inc new file mode 100644 index 0000000000..f6a0301ded --- /dev/null +++ b/packages/ptc/src/x11/includes.inc @@ -0,0 +1,16 @@ +{$INCLUDE x11modesd.inc} +{$INCLUDE x11imaged.inc} +{$INCLUDE x11displayd.inc} +{$INCLUDE x11windowdisplayd.inc} +{$INCLUDE x11dga1displayd.inc} +{$INCLUDE x11dga2displayd.inc} +{$INCLUDE x11consoled.inc} + +{$INCLUDE check.inc} +{$INCLUDE x11modesi.inc} +{$INCLUDE x11imagei.inc} +{$INCLUDE x11displayi.inc} +{$INCLUDE x11windowdisplayi.inc} +{$INCLUDE x11dga1displayi.inc} +{$INCLUDE x11dga2displayi.inc} +{$INCLUDE x11consolei.inc} diff --git a/packages/ptc/src/x11/x11consoled.inc b/packages/ptc/src/x11/x11consoled.inc new file mode 100644 index 0000000000..872698cc37 --- /dev/null +++ b/packages/ptc/src/x11/x11consoled.inc @@ -0,0 +1,82 @@ +Type + TX11Console = Class(TPTCBaseConsole) + Private + FX11Display : TX11Display; + FTitle : String; + FFlags : TX11Flags; + FModes : Array Of TPTCMode; + + Procedure UpdateCursor; + + Function CreateDisplay : TX11Display; { Factory method } + + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Function GetPitch : Integer; Override; + Function GetArea : TPTCArea; Override; + Function GetFormat : TPTCFormat; Override; + Function GetPages : Integer; Override; + Function GetName : String; Override; + Function GetTitle : String; Override; + Function GetInformation : String; Override; + Public + Constructor Create; Override; + Destructor Destroy; Override; + + Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); Overload; Override; + Procedure Close; Override; + + Procedure Copy(Var ASurface : TPTCBaseSurface); Override; + Procedure Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); Override; + + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Override; + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Override; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Override; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Override; + + Function Lock : Pointer; Override; + Procedure Unlock; Override; + + Procedure Clear; Override; + Procedure Clear(Const AColor : TPTCColor); Override; + Procedure Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); Override; + + Procedure Configure(Const AFileName : String); Override; + Function Option(Const AOption : String) : Boolean; Override; + + Procedure Palette(Const APalette : TPTCPalette); Override; + Procedure Clip(Const AArea : TPTCArea); Override; + Function Clip : TPTCArea; Override; + Function Palette : TPTCPalette; Override; + Function Modes : PPTCMode; Override; + + Procedure Flush; Override; + Procedure Finish; Override; + Procedure Update; Override; + Procedure Update(Const AArea : TPTCArea); Override; + + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override; + End; diff --git a/packages/ptc/src/x11/x11consolei.inc b/packages/ptc/src/x11/x11consolei.inc new file mode 100644 index 0000000000..1e9ccd0c46 --- /dev/null +++ b/packages/ptc/src/x11/x11consolei.inc @@ -0,0 +1,530 @@ +Constructor TX11Console.Create; + +Var + s : AnsiString; + +Begin + Inherited Create; + + { default flags } + FFlags := [PTC_X11_TRY_XSHM, PTC_X11_TRY_XF86VIDMODE]; + + FTitle := ''; + + Configure('/usr/share/ptcpas/ptcpas.conf'); + s := fpgetenv('HOME'); + If s = '' Then + s := '/'; + If s[Length(s)] <> '/' Then + s := s + '/'; + s := s + '.ptcpas.conf'; + Configure(s); +End; + +Destructor TX11Console.Destroy; + +Var + I : Integer; + +Begin + Close; + FreeAndNil(FX11Display); + For I := Low(FModes) To High(FModes) Do + FreeAndNil(FModes[I]); + Inherited Destroy; +End; + +Procedure TX11Console.Configure(Const AFileName : String); + +Var + F : Text; + S : String; + +Begin + AssignFile(F, AFileName); + {$I-} + Reset(F); + {$I+} + If IOResult <> 0 Then + Exit; + While Not EoF(F) Do + Begin + {$I-} + Readln(F, S); + {$I+} + If IOResult <> 0 Then + Break; + Option(S); + End; + CloseFile(F); +End; + +Function TX11Console.Option(Const AOption : String) : Boolean; + +Begin + Result := True; + If AOption = 'default output' Then + Begin + { default is windowed for now } + FFlags := FFlags - [PTC_X11_FULLSCREEN]; + Exit; + End; + If AOption = 'windowed output' Then + Begin + FFlags := FFlags - [PTC_X11_FULLSCREEN]; + Exit; + End; + If AOption = 'fullscreen output' Then + Begin + FFlags := FFlags + [PTC_X11_FULLSCREEN]; + Exit; + End; + If AOption = 'leave window open' Then + Begin + FFlags := FFlags + [PTC_X11_LEAVE_WINDOW]; + Exit; + End; + If AOption = 'leave display open' Then + Begin + FFlags := FFlags + [PTC_X11_LEAVE_DISPLAY]; + Exit; + End; + If AOption = 'dga' Then + Begin + FFlags := FFlags + [PTC_X11_TRY_DGA]; + Exit; + End; + If AOption = 'dga off' Then + Begin + FFlags := FFlags - [PTC_X11_TRY_DGA]; + Exit; + End; + If AOption = 'xf86vidmode' Then + Begin + FFlags := FFlags + [PTC_X11_TRY_XF86VIDMODE]; + Exit; + End; + If AOption = 'xf86vidmode off' Then + Begin + FFlags := FFlags - [PTC_X11_TRY_XF86VIDMODE]; + Exit; + End; + If AOption = 'xrandr' Then + Begin + FFlags := FFlags + [PTC_X11_TRY_XRANDR]; + Exit; + End; + If AOption = 'xrandr off' Then + Begin + FFlags := FFlags - [PTC_X11_TRY_XRANDR]; + Exit; + End; + If AOption = 'xshm' Then + Begin + FFlags := FFlags + [PTC_X11_TRY_XSHM]; + Exit; + End; + If AOption = 'xshm off' Then + Begin + FFlags := FFlags - [PTC_X11_TRY_XSHM]; + Exit; + End; + If AOption = 'default cursor' Then + Begin + FFlags := FFlags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE, PTC_X11_WINDOWED_CURSOR_INVISIBLE]; + UpdateCursor; + Exit; + End; + If AOption = 'show cursor' Then + Begin + FFlags := (FFlags - [PTC_X11_WINDOWED_CURSOR_INVISIBLE]) + [PTC_X11_FULLSCREEN_CURSOR_VISIBLE]; + UpdateCursor; + Exit; + End; + If AOption = 'hide cursor' Then + Begin + FFlags := (FFlags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE]) + [PTC_X11_WINDOWED_CURSOR_INVISIBLE]; + UpdateCursor; + Exit; + End; + If AOption = 'enable logging' Then + Begin + LOG_enabled := True; + Result := True; + Exit; + End; + If AOption = 'disable logging' Then + Begin + LOG_enabled := False; + Result := True; + Exit; + End; + + If Assigned(FX11Display) Then + Result := FX11Display.FCopy.Option(AOption) + Else + Result := False; +End; + +Function TX11Console.Modes : PPTCMode; + +Var + I : Integer; + +Begin + For I := Low(FModes) To High(FModes) Do + FreeAndNil(FModes[I]); + + If FX11Display = Nil Then + FX11Display := CreateDisplay; + + FX11Display.GetModes(FModes); + + Result := @FModes[0]; +End; + +{TODO: Find current pixel depth} +Procedure TX11Console.Open(Const ATitle : String; APages : Integer = 0); + +Var + tmp : TPTCFormat; + +Begin + tmp := TPTCFormat.Create(32, $FF0000, $FF00, $FF); + Try + Open(ATitle, tmp, APages); + Finally + tmp.Free; + End; +End; + +Procedure TX11Console.Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); + +Begin + Open(ATitle, 640, 480, AFormat, APages); +End; + +Procedure TX11Console.Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); + +Begin + Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages); +End; + +Function TX11Console.CreateDisplay : TX11Display; + +Var + display : PDisplay; + screen : Integer; + +Begin + { Check if we can open an X display } + display := XOpenDisplay(Nil); + If display = Nil Then + Raise TPTCError.Create('Cannot open X display'); + + { DefaultScreen should be fine } + screen := DefaultScreen(display); + + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2} + If PTC_X11_TRY_DGA In FFlags Then + Begin + Try + Result := TX11DGA2Display.Create(display, screen, FFlags + [PTC_X11_LEAVE_DISPLAY]); + Result.SetFlags(FFlags); + Exit; + Except + LOG('DGA 2.0 failed'); + End; + End; + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2} + + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1} + If PTC_X11_TRY_DGA In FFlags Then + Begin + Try + Result := TX11DGA1Display.Create(display, screen, FFlags + [PTC_X11_LEAVE_DISPLAY]); + Result.SetFlags(FFlags); + Except + LOG('DGA 1.0 failed'); + End; + End; + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1} + + Result := TX11WindowDisplay.Create(display, screen, FFlags); +End; + +Procedure TX11Console.Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); + +Begin + Close; + FTitle := ATitle; + + If FX11Display = Nil Then + FX11Display := CreateDisplay; + FX11Display.Open(ATitle, AWidth, AHeight, AFormat); + + UpdateCursor; +End; + +Procedure TX11Console.Close; + +Begin + FreeAndNil(FX11Display); +End; + +Procedure TX11Console.Flush; + +Begin + Update; +End; + +Procedure TX11Console.Finish; + +Begin + Update; +End; + +Procedure TX11Console.Update; + +Begin + FX11Display.Update; +End; + +Procedure TX11Console.Update(Const AArea : TPTCArea); + +Begin + FX11Display.Update(AArea); +End; + +Function TX11Console.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; + +Begin + Result := FX11Display.NextEvent(AEvent, AWait, AEventMask); +End; + +Function TX11Console.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; + +Begin + Result := FX11Display.PeekEvent(AWait, AEventMask); +End; + +Procedure TX11Console.Copy(Var ASurface : TPTCBaseSurface); + +Begin + {todo!...} +End; + +Procedure TX11Console.Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); + +Begin + {todo!...} +End; + +Function TX11Console.Lock : Pointer; + +Begin + Result := FX11Display.Lock; +End; + +Procedure TX11Console.Unlock; + +Begin + FX11Display.Unlock; +End; + +Procedure TX11Console.Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); + +Begin + FX11Display.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette); +End; + +Procedure TX11Console.Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); + +Begin + FX11Display.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination); +End; + +Procedure TX11Console.Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); + +Begin + {todo!...} +End; + +Procedure TX11Console.Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); + +Begin + {todo!...} +End; + +Procedure TX11Console.Clear; + +Var + tmp : TPTCColor; + +Begin + If Format.Direct Then + tmp := TPTCColor.Create(0, 0, 0, 0) + Else + tmp := TPTCColor.Create(0); + Try + Clear(tmp); + Finally + tmp.Free; + End; +End; + +Procedure TX11Console.Clear(Const AColor : TPTCColor); + +Begin + FX11Display.Clear(AColor); +End; + +Procedure TX11Console.Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); + +Begin + FX11Display.Clear(AColor, AArea); +End; + +Procedure TX11Console.Palette(Const APalette : TPTCPalette); + +Begin + FX11Display.Palette(APalette); +End; + +Function TX11Console.Palette : TPTCPalette; + +Begin + Result := FX11Display.Palette; +End; + +Procedure TX11Console.Clip(Const AArea : TPTCArea); + +Begin + FX11Display.Clip(AArea); +End; + +Function TX11Console.GetWidth : Integer; + +Begin + Result := FX11Display.Width; +End; + +Function TX11Console.GetHeight : Integer; + +Begin + Result := FX11Display.Height; +End; + +Function TX11Console.GetPitch : Integer; + +Begin + Result := FX11Display.Pitch; +End; + +Function TX11Console.GetPages : Integer; + +Begin + Result := 2; +End; + +Function TX11Console.GetArea : TPTCArea; + +Begin + Result := FX11Display.Area; +End; + +Function TX11Console.Clip : TPTCArea; + +Begin + Result := FX11Display.Clip; +End; + +Function TX11Console.GetFormat : TPTCFormat; + +Begin + Result := FX11Display.Format; +End; + +Function TX11Console.GetName : String; + +Begin + Result := 'X11'; +End; + +Function TX11Console.GetTitle : String; + +Begin + Result := FTitle; +End; + +Function TX11Console.GetInformation : String; + +Begin + If FX11Display = Nil Then + Exit('PTC X11'); + Result := 'PTC X11, '; + If FX11Display.IsFullScreen Then + Result := Result + 'fullscreen ' + Else + Result := Result + 'windowed '; + + { TODO: use virtual methods, instead of "is" } + If FX11Display Is TX11WindowDisplay Then + Begin + If TX11WindowDisplay(FX11Display).FPrimary <> Nil Then + Result := Result + '(' + TX11WindowDisplay(FX11Display).FPrimary.Name + ') ' + Else + Result := Result + ''; + End + Else + Begin + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2} + If FX11Display Is TX11DGA2Display Then + Result := Result + '(DGA) ' + Else + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2} + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1} + If FX11Display Is TX11DGA1Display Then + Result := Result + '(DGA) ' + Else + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1} + Begin + {...} + End; + End; + Result := Result + 'mode, ' + + IntToStr(FX11Display.Width) + 'x' + + IntToStr(FX11Display.Height) + ', ' + + IntToStr(FX11Display.Format.Bits) + ' bit'; +End; + +Procedure TX11Console.UpdateCursor; + +Begin + If Assigned(FX11Display) Then + Begin + If FX11Display.IsFullScreen Then + FX11Display.SetCursor(PTC_X11_FULLSCREEN_CURSOR_VISIBLE In FFlags) + Else + FX11Display.SetCursor(Not (PTC_X11_WINDOWED_CURSOR_INVISIBLE In FFlags)); + End; +End; diff --git a/packages/ptc/src/x11/x11dga1displayd.inc b/packages/ptc/src/x11/x11dga1displayd.inc new file mode 100644 index 0000000000..6abfd2cb35 --- /dev/null +++ b/packages/ptc/src/x11/x11dga1displayd.inc @@ -0,0 +1,45 @@ +{$IFDEF ENABLE_X11_EXTENSION_XF86DGA1} + +Type + TX11DGA1Display = Class(TX11Display) + Private + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override; + + Procedure HandleEvents; + + FModeInfo : PPXF86VidModeModeInfo; + FModeInfoNum : Integer; + FPreviousMode : Integer; + + FDGAAddr : PByte; + FDGALineWidth : Integer; + FDGABankSize : Integer; + FDGAMemSize : Integer; + FDGAWidth, FDGAHeight : Integer; + + { Coordinates of upper left frame corner } + FDestX, FDestY : Integer; + + FInDirect, FInMode : Boolean; + Public + Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Override; + Destructor Destroy; Override; + + Procedure Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); Override; + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat); Override; + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); Override; + Procedure Close; Override; + Procedure GetModes(Var AModes : TPTCModeDynArray); Override; + Procedure Update; Override; + Procedure Update(Const AArea : TPTCArea); Override; + Function Lock : Pointer; Override; + Procedure Unlock; Override; + Procedure Palette(Const APalette : TPTCPalette); Override; + Function GetPitch : Integer; Override; + Function GetX11Window : TWindow; Override; + Function IsFullScreen : Boolean; Override; + Procedure SetCursor(AVisible : Boolean); Override; + End; + +{$ENDIF ENABLE_X11_EXTENSION_XF86DGA1} diff --git a/packages/ptc/src/x11/x11dga1displayi.inc b/packages/ptc/src/x11/x11dga1displayi.inc new file mode 100644 index 0000000000..1eb4ba1ae0 --- /dev/null +++ b/packages/ptc/src/x11/x11dga1displayi.inc @@ -0,0 +1,507 @@ +{$IFDEF ENABLE_X11_EXTENSION_XF86DGA1} + +Constructor TX11DGA1Display.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); + +Var + dummy1, dummy2 : Integer; + +Begin + Inherited; + + LOG('trying to create a DGA 1.0 display'); + + FInDirect := False; + FInMode := False; + FModeInfo := Nil; + + { Check if we are root } + If fpgeteuid <> 0 Then + Raise TPTCError.Create('Have to be root to switch to DGA mode'); + + { Check if the DGA extension and VidMode extension can be used } + If Not XF86DGAQueryExtension(FDisplay, @dummy1, @dummy2) Then + Raise TPTCError.Create('DGA extension not available'); + If Not XF86VidModeQueryExtension(FDisplay, @dummy1, @dummy2) Then + Raise TPTCError.Create('VidMode extension not available'); +End; + +Destructor TX11DGA1Display.Destroy; + +Begin + Close; + Inherited Destroy; +End; + +Procedure TX11DGA1Display.Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); + +Var + vml : PXF86VidModeModeLine; + dotclock : Integer; + i : Integer; + root : TWindow; + e : TXEvent; + found : Boolean; + tmpArea : TPTCArea; + r, g, b : Single; + found_mode : Integer; + min_diff : Integer; + d_x, d_y : Integer; + +Begin + FWidth := AWidth; + FHeight := AHeight; + + { Get all availabe video modes } + XF86VidModeGetAllModeLines(FDisplay, FScreen, @FModeInfoNum, @FModeInfo); + + FPreviousMode := -1; + { Save previous mode } + New(vml); + Try + XF86VidModeGetModeLine(FDisplay, FScreen, @dotclock, vml); + Try + For i := 0 To FModeInfoNum - 1 Do + Begin + If (vml^.hdisplay = FModeInfo[i]^.hdisplay) And + (vml^.vdisplay = FModeInfo[i]^.vdisplay) Then + Begin + FPreviousMode := i; + Break; + End; + End; + Finally + If vml^.privsize <> 0 Then + XFree(vml^.c_private); + End; + Finally + Dispose(vml); + End; + If FPreviousMode = -1 Then + Raise TPTCError.Create('Current mode not found in modelist?! Err, this shouldn''t happen :)'); + + { Find a video mode to set } + + { Normal modesetting first, find exactly matching mode } + found_mode := -1; + For i := 0 To FModeInfoNum - 1 Do + If (FModeInfo[i]^.hdisplay = AWidth) And (FModeInfo[i]^.vdisplay = AHeight) Then + Begin + found_mode := i; + Break; + End; + + { Try to find a mode that matches the width first } + If found_mode = -1 Then + For i := 0 To FModeInfoNum - 1 Do + If (FModeInfo[i]^.hdisplay = AWidth) And + (FModeInfo[i]^.vdisplay >= AHeight) Then + Begin + found_mode := i; + Break; + End; + + { Next try to match the height } + If found_mode = -1 Then + For i := 0 To FModeInfoNum - 1 Do + If (FModeInfo[i]^.hdisplay >= AWidth) And + (FModeInfo[i]^.vdisplay = AHeight) Then + Begin + found_mode := i; + Break; + End; + + If found_mode = -1 Then + Begin + { Finally, find the mode that is bigger than the requested one and makes } + { the least difference } + min_diff := 987654321; + For i := 0 To FModeInfoNum - 1 Do + If (FModeInfo[i]^.hdisplay >= AWidth) And (FModeInfo[i]^.vdisplay >= AHeight) Then + Begin + d_x := Sqr(FModeInfo[i]^.hdisplay - AWidth); + d_y := Sqr(FModeInfo[i]^.vdisplay - AHeight); + If (d_x + d_y) < min_diff Then + Begin + min_diff := d_x + d_y; + found_mode := i; + End; + End; + End; + + If found_mode = -1 Then + Raise TPTCError.Create('Cannot find a video mode to use'); + + If Not XF86VidModeSwitchToMode(FDisplay, FScreen, FModeInfo[found_mode]) Then + Raise TPTCError.Create('Error switching to requested video mode'); + FDestX := (FModeInfo[found_mode]^.hdisplay Div 2) - (AWidth Div 2); + FDestY := (FModeInfo[found_mode]^.vdisplay Div 2) - (AHeight Div 2); + + XFlush(FDisplay); + FInMode := True; + + { Check if the requested colour mode is available } + FFormat := GetX11Format(AFormat); + + { Grab exclusive control over the keyboard and mouse } + root := XRootWindow(FDisplay, FScreen); + XGrabKeyboard(FDisplay, root, True, GrabModeAsync, GrabModeAsync, CurrentTime); + XGrabPointer(FDisplay, root, True, PointerMotionMask Or ButtonPressMask Or + ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None, + CurrentTime); + XFlush(FDisplay); + + { Get Display information } + XF86DGAGetVideo(FDisplay, FScreen, @FDGAAddr, @FDGALineWidth, + @FDGABankSize, @FDGAMemSize); + + { Don't have to be root anymore } +{ fpsetuid(fpgetuid);...} + + XF86DGAGetViewPortSize(FDisplay, FScreen, @FDGAWidth, @FDGAHeight); + + If XF86DGAForkApp(FScreen) <> 0 Then + Raise TPTCError.Create('cannot do safety fork'); + + If XF86DGADirectVideo(FDisplay, FScreen, XF86DGADirectGraphics Or + XF86DGADirectKeyb Or XF86DGADirectMouse) = 0 Then + Raise TPTCError.Create('cannot switch to DGA mode'); + + FInDirect := True; + FillChar(FDGAAddr^, FDGALineWidth * FDGAHeight * (FFormat.Bits Div 8), 0); + + XSelectInput(FDisplay, DefaultRootWindow(FDisplay), + KeyPressMask Or KeyReleaseMask); + + XF86DGASetViewPort(FDisplay, FScreen, 0, 0); { Important.. sort of =) } + + found := False; + Repeat + { Stupid loop. The key } + { events were causing } + { problems.. } + found := XCheckMaskEvent(FDisplay, KeyPressMask Or KeyReleaseMask, @e); + Until Not found; + + { Create colour map in 8 bit mode } + 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'); + 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); + XF86DGAInstallColormap(FDisplay, FScreen, FCMap); + End; + + { Set clipping area } + tmpArea := TPTCArea.Create(0, 0, FWidth, FHeight); + Try + FClip.Assign(tmpArea); + Finally + tmpArea.Free; + End; +End; + +{ Not in DGA mode } +Procedure TX11DGA1Display.Open(AWindow : TWindow; Const AFormat : TPTCFormat); + +Begin + If AWindow = 0 Then; { Prevent warnings } + If AFormat = Nil Then; +End; + +Procedure TX11DGA1Display.Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); + +Begin + If (AWindow = 0) Or + (AFormat = Nil) Or + (AX = 0) Or + (AY = 0) Or + (AWidth = 0) Or + (AHeight = 0) Then; +End; + +Procedure TX11DGA1Display.Close; + +Begin + If FInDirect Then + Begin + FInDirect := False; + XF86DGADirectVideo(FDisplay, FScreen, 0); + End; + + If FInMode Then + Begin + FInMode := False; + XF86VidModeSwitchToMode(FDisplay, FScreen, FModeInfo[FPreviousMode]); + XUngrabKeyboard(FDisplay, CurrentTime); + XUngrabPointer(FDisplay, CurrentTime); + End; + + If FDisplay <> Nil Then + XFlush(FDisplay); + + If FCMap <> 0 Then + Begin + XFreeColormap(FDisplay, FCMap); + FCMap := 0; + End; + + FreeMemAndNil(FColours); + + If FModeInfo <> Nil Then + Begin + XFree(FModeInfo); + FModeInfo := Nil; + End; +End; + +Procedure TX11DGA1Display.GetModes(Var AModes : TPTCModeDynArray); + +Begin + SetLength(AModes, 1); + AModes[0] := TPTCMode.Create; + {todo...} +End; + +Procedure TX11DGA1Display.Update; + +Begin +End; + +Procedure TX11DGA1Display.Update(Const AArea : TPTCArea); + +Begin +End; + +Procedure TX11DGA1Display.HandleEvents; + +Var + e : TXEvent; + NewFocus : Boolean; + NewFocusSpecified : Boolean; + + Function UsefulEventsPending : Boolean; + + Var + tmpEvent : TXEvent; + + Begin + If XCheckTypedEvent(FDisplay, ClientMessage, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + If XCheckMaskEvent(FDisplay, FocusChangeMask Or + KeyPressMask Or KeyReleaseMask Or + ButtonPressMask Or ButtonReleaseMask Or + PointerMotionMask Or ExposureMask, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + Result := False; + End; + + Procedure HandleKeyEvent; + + Var + sym : TKeySym; + sym_modded : TKeySym; { modifiers like shift are taken into account here } + press : Boolean; + alt, shift, ctrl : Boolean; + uni : Integer; + key : TPTCKeyEvent; + buf : Array[1..16] Of Char; + + Begin + sym := XLookupKeySym(@e.xkey, 0); + XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil); + uni := X11ConvertKeySymToUnicode(sym_modded); + alt := (e.xkey.state And Mod1Mask) <> 0; + shift := (e.xkey.state And ShiftMask) <> 0; + ctrl := (e.xkey.state And ControlMask) <> 0; + If e._type = KeyPress Then + press := True + Else + press := False; + + key := Nil; + Case sym Shr 8 Of + 0 : key := TPTCKeyEvent.Create(FNormalKeys[sym And $FF], uni, alt, shift, ctrl, press); + $FF : key := TPTCKeyEvent.Create(FFunctionKeys[sym And $FF], uni, alt, shift, ctrl, press); + Else + key := TPTCKeyEvent.Create; + End; + FEventQueue.AddEvent(key); + 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]) = m_atom_close) Then + Halt(0);} + End; + Expose : Begin + {...} + End; + KeyPress, KeyRelease : HandleKeyEvent; + ButtonPress, ButtonRelease : Begin + {...} + End; + MotionNotify : Begin + {...} + End; + End; + End; +// HandleChangeFocus(NewFocus); +End; + +Function TX11DGA1Display.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; + +Var + tmpEvent : TXEvent; + +Begin + FreeAndNil(AEvent); + 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 TX11DGA1Display.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; + +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 TX11DGA1Display.Lock : Pointer; + +Begin + Result := FDGAAddr + FDGALineWidth * FDestY * (FFormat.Bits Div 8) + + FDestX * (FFormat.Bits Div 8); +End; + +Procedure TX11DGA1Display.Unlock; + +Begin +End; + +Procedure TX11DGA1Display.Palette(Const APalette : TPTCPalette); + +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); + XF86DGAInstallColormap(FDisplay, FScreen, FCMap); +End; + +Function TX11DGA1Display.GetPitch : Integer; + +Begin + Result := FDGALineWidth * (FFormat.Bits Div 8); +End; + +Function TX11DGA1Display.GetX11Window : TWindow; + +Begin + Result := DefaultRootWindow(FDisplay); +End; + +Function TX11DGA1Display.IsFullScreen : Boolean; + +Begin + { DGA is always fullscreen } + Result := True; +End; + +Procedure TX11DGA1Display.SetCursor(AVisible : Boolean); + +Begin + {nothing... raise exception if visible=true?} +End; + +{$ENDIF ENABLE_X11_EXTENSION_XF86DGA1} diff --git a/packages/ptc/src/x11/x11dga2displayd.inc b/packages/ptc/src/x11/x11dga2displayd.inc new file mode 100644 index 0000000000..7acb24f365 --- /dev/null +++ b/packages/ptc/src/x11/x11dga2displayd.inc @@ -0,0 +1,44 @@ +{$IFDEF ENABLE_X11_EXTENSION_XF86DGA2} + +Type + TX11DGA2Display = Class(TX11Display) + Private + Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override; + + Procedure HandleEvents; + + { The list of available modes (todo: move to local vars in the open function) } + FXDGAModes : PXDGAMode; + FXDGAModesNum : cint; + + { Holds the pointer to the framebuffer and all the other information for + the current mode (or nil, if a mode isn't open) } + FXDGADevice : PXDGADevice; + + { Coordinates of upper left frame corner } + m_destx, m_desty : Integer; + + FModeIsSet : Boolean; + FFramebufferIsOpen : Boolean; + Public + Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Override; + Destructor Destroy; Override; + + Procedure open(title : String; _width, _height : Integer; Const _format : TPTCFormat); Override; + Procedure open(w : TWindow; Const _format : TPTCFormat); Override; + Procedure open(_window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); Override; + Procedure close; Override; + Procedure GetModes(Var AModes : TPTCModeDynArray); Override; + Procedure update; Override; + Procedure update(Const _area : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function GetPitch : Integer; Override; + Function getX11Window : TWindow; Override; + Function isFullScreen : Boolean; Override; + Procedure SetCursor(visible : Boolean); Override; + End; + +{$ENDIF ENABLE_X11_EXTENSION_XF86DGA2} diff --git a/packages/ptc/src/x11/x11dga2displayi.inc b/packages/ptc/src/x11/x11dga2displayi.inc new file mode 100644 index 0000000000..c73236eb39 --- /dev/null +++ b/packages/ptc/src/x11/x11dga2displayi.inc @@ -0,0 +1,451 @@ +{$IFDEF ENABLE_X11_EXTENSION_XF86DGA2} + +Constructor TX11DGA2Display.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); + +Var + dummy1, dummy2 : cint; + +Begin + Inherited; + + LOG('trying to open a DGA 2.0 display'); + + { Check if the DGA extension can be used } + LOG('checking if the DGA extension can be used (XDGAQueryExtension)'); + If Not XDGAQueryExtension(FDisplay, @dummy1, @dummy2) Then + Raise TPTCError.Create('DGA extension not available'); +End; + +Destructor TX11DGA2Display.Destroy; + +Begin + Close; + Inherited Destroy; +End; + +Procedure TX11DGA2Display.open(title : String; _width, _height : Integer; Const _format : TPTCFormat); + +Var + vml : PXF86VidModeModeLine; + dotclock : Integer; + i : Integer; + found : Boolean; + root : TWindow; + e : TXEvent; + tmpArea : TPTCArea; + r, g, b : Single; + found_mode : Integer; + min_diff : Integer; + d_x, d_y : Integer; + +Begin + FWidth := _width; + FHeight := _height; + + LOG('trying to open framebuffer (XDGAOpenFramebuffer)'); + If Not XDGAOpenFramebuffer(FDisplay, FScreen) Then + Raise TPTCError.Create('Cannot open framebuffer - insufficient privileges?'); + FFramebufferIsOpen := True; + + { Get all availabe video modes } + LOG('querying available display modes (XDGAQueryModes)'); + FXDGAModes := XDGAQueryModes(FDisplay, FScreen, @FXDGAModesNum); + + LOG('number of display modes', FXDGAModesNum); + + For I := 0 To FXDGAModesNum - 1 Do + Begin + LOG('mode#', I); + LOG('num', FXDGAModes[I].num); + LOG('name: ' + FXDGAModes[I].name); + End; + + found_mode := 0; // todo: find a video mode + + Raise TPTCError.Create('break! dga 2.0 code unfinished'); + + FXDGADevice := XDGASetMode(FDisplay, FScreen, found_mode); + If FXDGADevice = Nil Then + Raise TPTCError.Create('XDGASetMode failed (returned nil)'); + If FXDGADevice^.data = Nil Then + Raise TPTCError.Create('The pointer to the framebuffer, returned by XDGA is nil?!'); + FModeIsSet := True; + + { Check if the requested colour mode is available } + FFormat := GetX11Format(_format); + + { Grab exclusive control over the keyboard and mouse } +{ root := XRootWindow(FDisplay, FScreen); + XGrabKeyboard(FDisplay, root, True, GrabModeAsync, GrabModeAsync, CurrentTime); + XGrabPointer(FDisplay, root, True, PointerMotionMask Or ButtonPressMask Or + ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None, + CurrentTime);} + XFlush(FDisplay); + + { Get Display information } +{ XF86DGAGetVideo(FDisplay, FScreen, @dga_addr, @dga_linewidth, + @dga_banksize, @dga_memsize);} + + { Don't have to be root anymore } +{ setuid(getuid);...} + +// XF86DGAGetViewPortSize(FDisplay, FScreen, @dga_width, @dga_height); + +{ If XF86DGAForkApp(FScreen) <> 0 Then + Raise TPTCError.Create('cannot do safety fork') + Else + Begin + If XF86DGADirectVideo(FDisplay, FScreen, XF86DGADirectGraphics Or + XF86DGADirectKeyb Or XF86DGADirectMouse) = 0 Then + Raise TPTCError.Create('cannot switch to DGA mode'); + End;} + +// m_indirect := True; +// FillChar(dga_addr^, dga_linewidth * dga_height * (FFormat.bits Div 8), 0); + + XSelectInput(FDisplay, DefaultRootWindow(FDisplay), + KeyPressMask Or KeyReleaseMask); + + XF86DGASetViewPort(FDisplay, FScreen, 0, 0); { Important.. sort of =) } + + found := False; + Repeat + { Stupid loop. The key } + { events were causing } + { problems.. } + found := XCheckMaskEvent(FDisplay, KeyPressMask Or KeyReleaseMask, @e); + Until Not found; + + { Create colour map in 8 bit mode } + 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'); + 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); + XF86DGAInstallColormap(FDisplay, FScreen, FCMap); + End; + + { Set clipping area } + tmpArea := TPTCArea.Create(0, 0, FWidth, FHeight); + Try + FClip.Assign(tmpArea); + Finally + tmpArea.Free; + End; +End; + +{ Not in DGA mode } +Procedure TX11DGA2Display.open(w : TWindow; Const _format : TPTCFormat); + +Begin + If w = 0 Then; { Prevent warnings } + If _format = Nil Then; +End; + +Procedure TX11DGA2Display.open(_window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); + +Begin + If (_window = 0) Or (_format = Nil) Or (x = 0) Or + (y = 0) Or (w = 0) Or (h = 0) Then; +End; + +Procedure TX11DGA2Display.close; + +Var + tmp : Pointer; + +Begin + If FModeIsSet Then + Begin + FModeIsSet := False; + + { restore the original mode } + XDGASetMode(FDisplay, FScreen, 0); { returns PXDGADevice } +{ XUngrabKeyboard(FDisplay, CurrentTime); + XUngrabPointer(FDisplay, CurrentTime);} + End; + + If FFramebufferIsOpen Then + Begin + FFramebufferIsOpen := False; + XDGACloseFramebuffer(FDisplay, FScreen); + End; + + If FDisplay <> Nil Then + XFlush(FDisplay); + + If FCMap <> 0 Then + Begin + XFreeColormap(FDisplay, FCMap); + FCMap := 0; + End; + + FreeMemAndNil(FColours); + + If FXDGADevice <> Nil Then + Begin + tmp := FXDGADevice; + FXDGADevice := Nil; + XFree(tmp); + End; + + If FXDGAModes <> Nil Then + Begin + tmp := FXDGAModes; + FXDGAModes := Nil; + XFree(tmp); + End; +End; + +Procedure TX11DGA2Display.GetModes(Var AModes : TPTCModeDynArray); + +Begin + SetLength(AModes, 1); + AModes[0] := TPTCMode.Create; + {todo...} +End; + +Procedure TX11DGA2Display.update; + +Begin +End; + +Procedure TX11DGA2Display.update(Const _area : TPTCArea); + +Begin +End; + +Procedure TX11DGA2Display.HandleEvents; + +Var + e : TXEvent; + NewFocus : Boolean; + NewFocusSpecified : Boolean; + + Function UsefulEventsPending : Boolean; + + Var + tmpEvent : TXEvent; + + Begin + If XCheckTypedEvent(FDisplay, ClientMessage, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + If XCheckMaskEvent(FDisplay, FocusChangeMask Or + KeyPressMask Or KeyReleaseMask Or + ButtonPressMask Or ButtonReleaseMask Or + PointerMotionMask Or ExposureMask, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + Result := False; + End; + + Procedure HandleKeyEvent; + + Var + sym : TKeySym; + sym_modded : TKeySym; { modifiers like shift are taken into account here } + press : Boolean; + alt, shift, ctrl : Boolean; + uni : Integer; + key : TPTCKeyEvent; + buf : Array[1..16] Of Char; + + Begin + sym := XLookupKeySym(@e.xkey, 0); + XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil); + uni := X11ConvertKeySymToUnicode(sym_modded); + alt := (e.xkey.state And Mod1Mask) <> 0; + shift := (e.xkey.state And ShiftMask) <> 0; + ctrl := (e.xkey.state And ControlMask) <> 0; + If e._type = KeyPress Then + press := True + Else + press := False; + + key := Nil; + Case sym Shr 8 Of + 0 : key := TPTCKeyEvent.Create(FNormalKeys[sym And $FF], uni, alt, shift, ctrl, press); + $FF : key := TPTCKeyEvent.Create(FFunctionKeys[sym And $FF], uni, alt, shift, ctrl, press); + Else + key := TPTCKeyEvent.Create; + End; + FEventQueue.AddEvent(key); + 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]) = m_atom_close) Then + Halt(0);} + End; + Expose : Begin + {...} + End; + KeyPress, KeyRelease : HandleKeyEvent; + ButtonPress, ButtonRelease : Begin + {...} + End; + MotionNotify : Begin + {...} + End; + End; + End; +// HandleChangeFocus(NewFocus); +End; + +Function TX11DGA2Display.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; + +Var + tmpEvent : TXEvent; + +Begin + FreeAndNil(event); + Repeat + { process all events from the X queue and put them on our FEventQueue } + HandleEvents; + + { try to find an event that matches the EventMask } + event := FEventQueue.NextEvent(EventMask); + + If wait And (event = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(FDisplay, @tmpEvent); + End; + Until (Not Wait) Or (event <> Nil); + Result := event <> Nil; +End; + +Function TX11DGA2Display.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; + +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(EventMask); + + If wait And (Result = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(FDisplay, @tmpEvent); + End; + Until (Not Wait) Or (Result <> Nil); +End; + + +Function TX11DGA2Display.lock : Pointer; + +Begin + lock := PByte(FXDGADevice^.data) + + FXDGADevice^.mode.bytesPerScanline * m_desty + + m_destx * (FXDGADevice^.mode.bitsPerPixel Div 8); +End; + +Procedure TX11DGA2Display.unlock; + +Begin +End; + +Procedure TX11DGA2Display.palette(Const _palette : TPTCPalette); + +Var + pal : PUint32; + i : Integer; + +Begin + pal := _palette.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); + XF86DGAInstallColormap(FDisplay, FScreen, FCMap); +End; + +Function TX11DGA2Display.GetPitch : Integer; + +Begin + Result := FXDGADevice^.mode.bytesPerScanline; +End; + +Function TX11DGA2Display.getX11Window : TWindow; + +Begin + Result := DefaultRootWindow(FDisplay); +End; + +Function TX11DGA2Display.isFullScreen : Boolean; + +Begin + { DGA is always fullscreen } + Result := True; +End; + +Procedure TX11DGA2Display.SetCursor(visible : Boolean); + +Begin + {nothing... raise exception if visible=true?} +End; + +{$ENDIF ENABLE_X11_EXTENSION_XF86DGA2} diff --git a/packages/ptc/src/x11/x11dgadisplayd.inc b/packages/ptc/src/x11/x11dgadisplayd.inc new file mode 100644 index 0000000000..c46ee8092f --- /dev/null +++ b/packages/ptc/src/x11/x11dgadisplayd.inc @@ -0,0 +1,40 @@ +Type + TX11DGADisplay = Class(TX11Display) + Private + Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override; + + Procedure HandleEvents; + + modeinfo : PPXF86VidModeModeInfo; + num_modeinfo : Integer; + previousmode : Integer; + + dga_addr : PByte; + dga_linewidth : Integer; + dga_banksize : Integer; + dga_memsize : Integer; + dga_width, dga_height : Integer; + + { Coordinates of upper left frame corner } + m_destx, m_desty : Integer; + + m_indirect, m_inmode : Boolean; + Public + Constructor Create; + Destructor Destroy; Override; + + Procedure open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer); Override; + Procedure open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat); Override; + Procedure open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); Override; + Procedure close; Override; + Procedure update; Override; + Procedure update(Const _area : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function pitch : Integer; Override; + Function getX11Window : TWindow; Override; + Function isFullScreen : Boolean; Override; + Procedure SetCursor(visible : Boolean); Override; + End; diff --git a/packages/ptc/src/x11/x11dgadisplayi.inc b/packages/ptc/src/x11/x11dgadisplayi.inc new file mode 100644 index 0000000000..ec3cce862d --- /dev/null +++ b/packages/ptc/src/x11/x11dgadisplayi.inc @@ -0,0 +1,528 @@ +Constructor TX11DGADisplay.Create; + +Begin + m_indirect := False; + m_inmode := False; + modeinfo := Nil; + Inherited Create; + +// dga_LoadLibrary; + +{ If (XF86DGAQueryExtension = Nil) Or (XF86DGAGetVideo = Nil) Or + (XF86DGAGetViewPortSize = Nil) Or (XF86DGAForkApp = Nil) Or + (XF86DGADirectVideo = Nil) Or (XF86DGASetViewPort = Nil) Or + (XF86DGAInstallColormap = Nil) Then + Raise TPTCError.Create('DGA extension not available');} +End; + +Destructor TX11DGADisplay.Destroy; + +Begin + close; {fix close!} +// dga_UnloadLibrary; + Inherited Destroy; +End; + +Procedure TX11DGADisplay.open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer); + +Var + dummy1, dummy2 : Integer; + vml : PXF86VidModeModeLine; + dotclock : Integer; + i : Integer; + found : Boolean; + root : TWindow; + e : TXEvent; + tmpArea : TPTCArea; + r, g, b : Single; + found_mode : Integer; + min_diff : Integer; + d_x, d_y : Integer; + +Begin + m_disp := disp; + m_screen := screen; + m_width := _width; + m_height := _height; + + { Check if we are root } + If fpgeteuid <> 0 Then + Raise TPTCError.Create('Have to be root to switch to DGA mode'); + + { Check if the DGA extension and VidMode extension can be used } + If Not XF86DGAQueryExtension(disp, @dummy1, @dummy2) Then + Raise TPTCError.Create('DGA extension not available'); + If Not XF86VidModeQueryExtension(disp, @dummy1, @dummy2) Then + Raise TPTCError.Create('VidMode extension not available'); + + { Get all availabe video modes } + XF86VidModeGetAllModeLines(m_disp, m_screen, @num_modeinfo, @modeinfo); + + previousmode := -1; + { Save previous mode } + New(vml); + Try + XF86VidModeGetModeLine(m_disp, m_screen, @dotclock, vml); + Try + For i := 0 To num_modeinfo - 1 Do + Begin + If (vml^.hdisplay = modeinfo[i]^.hdisplay) And + (vml^.vdisplay = modeinfo[i]^.vdisplay) Then + Begin + previousmode := i; + Break; + End; + End; + Finally + If vml^.privsize <> 0 Then + XFree(vml^.c_private); + End; + Finally + Dispose(vml); + End; + If previousmode = -1 Then + Raise TPTCError.Create('Current mode not found in modelist?! Err, this shouldn''t happen :)'); + + { Find a video mode to set } + + { Normal modesetting first, find exactly matching mode } + If Not (PTC_X11_PEDANTIC_DGA In m_flags) Then + Begin + found := False; + For i := 0 To num_modeinfo - 1 Do + Begin + If (modeinfo[i]^.hdisplay = _width) And (modeinfo[i]^.vdisplay = _height) Then + Begin + If Not XF86VidModeSwitchToMode(m_disp, m_screen, modeinfo[i]) Then + Raise TPTCError.Create('Error switching to requested video mode'); + m_destx := 0; + m_desty := 0; + found := True; + Break; + End; + End; + If Not found Then + Raise TPTCError.Create('Cannot find matching DGA video mode'); + End + Else + Begin + found_mode := $FFFF; + + { Try to find a mode that matches the width first } + For i := 0 To num_modeinfo - 1 Do + Begin + If (modeinfo[i]^.hdisplay = _width) And + (modeinfo[i]^.vdisplay >= _height) Then + Begin + found_mode := i; + Break; + End; + End; + + { Next try to match the height } + If found_mode = $FFFF Then + For i := 0 To num_modeinfo - 1 Do + Begin + If (modeinfo[i]^.hdisplay >= _width) And + (modeinfo[i]^.vdisplay = _height) Then + Begin + found_mode := i; + Break; + End; + End; + + { Finally, find the mode that is bigger than the requested one and makes } + { the least difference } + min_diff := 987654321; + + For i := 0 To num_modeinfo - 1 Do + Begin + If (modeinfo[i]^.hdisplay >= _width) And (modeinfo[i]^.vdisplay >= _height) Then + Begin + d_x := modeinfo[i]^.hdisplay - _width; + d_x *= d_x; + d_y := modeinfo[i]^.vdisplay - _height; + d_y *= d_y; + If (d_x + d_y) < min_diff Then + Begin + min_diff := d_x + d_y; + found_mode := i; + End; + End; + End; + + If found_mode <> $FFFF Then + Begin + If Not XF86VidModeSwitchToMode(m_disp, m_screen, modeinfo[found_mode]) Then + Raise TPTCError.Create('Error switching to requested video mode'); + m_destx := (modeinfo[found_mode]^.hdisplay Div 2) - (_width Div 2); + m_desty := (modeinfo[found_mode]^.vdisplay Div 2) - (_height Div 2); + End + Else + Raise TPTCError.Create('Cannot find a video mode to use'); + End; + XFlush(m_disp); + m_inmode := True; + + { Check if the requested colour mode is available } + m_format := getFormat(_format); + + { Grab exclusive control over the keyboard and mouse } + root := XRootWindow(m_disp, m_screen); + XGrabKeyboard(m_disp, root, True, GrabModeAsync, GrabModeAsync, CurrentTime); + XGrabPointer(m_disp, root, True, PointerMotionMask Or ButtonPressMask Or + ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None, + CurrentTime); + XFlush(m_disp); + + { Get Display information } + XF86DGAGetVideo(m_disp, m_screen, @dga_addr, @dga_linewidth, + @dga_banksize, @dga_memsize); + + { Don't have to be root anymore } +{ setuid(getuid);...} + + XF86DGAGetViewPortSize(m_disp, m_screen, @dga_width, @dga_height); + + If XF86DGAForkApp(m_screen) <> 0 Then + Raise TPTCError.Create('cannot do safety fork') + Else + Begin + If XF86DGADirectVideo(m_disp, m_screen, XF86DGADirectGraphics Or + XF86DGADirectKeyb Or XF86DGADirectMouse) = 0 Then + Raise TPTCError.Create('cannot switch to DGA mode'); + End; + + m_indirect := True; + FillChar(dga_addr^, dga_linewidth * dga_height * (m_format.bits Div 8), 0); + + XSelectInput(m_disp, DefaultRootWindow(m_disp), + KeyPressMask Or KeyReleaseMask); + + XF86DGASetViewPort(m_disp, m_screen, 0, 0); { Important.. sort of =) } + + found := False; + Repeat + { Stupid loop. The key } + { events were causing } + { problems.. } + found := XCheckMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e); + Until Not found; + + { Create colour map in 8 bit mode } + If m_format.bits = 8 Then + Begin + m_colours := GetMem(256 * SizeOf(TXColor)); + If m_colours = Nil Then + Raise TPTCError.Create('Cannot allocate colour map cells'); + m_cmap := XCreateColormap(m_disp, RootWindow(m_disp, m_screen), + DefaultVisual(m_disp, m_screen), AllocAll); + If m_cmap = 0 Then + Raise TPTCError.Create('Cannot create colour map'); + End + Else + m_cmap := 0; + + { Set 332 palette, for now } + If (m_format.bits = 8) And m_format.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; + + m_colours[i].pixel := i; + + m_colours[i].red := Round(r) Shl 8; + m_colours[i].green := Round(g) Shl 8; + m_colours[i].blue := Round(b) Shl 8; + + Byte(m_colours[i].flags) := DoRed Or DoGreen Or DoBlue; + End; + XStoreColors(m_disp, m_cmap, m_colours, 256); + XF86DGAInstallColormap(m_disp, m_screen, m_cmap); + End; + + { Set clipping area } + tmpArea := TPTCArea.Create(0, 0, m_width, m_height); + Try + m_clip.ASSign(tmpArea); + Finally + tmpArea.Free; + End; +End; + +{ Not in DGA mode } +Procedure TX11DGADisplay.open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat); + +Begin + If disp = Nil Then; { Prevent warnings } + If screen = 0 Then; + If w = 0 Then; + If _format = Nil Then; +End; + +Procedure TX11DGADisplay.open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); + +Begin + If (disp = Nil) Or (screen = 0) Or (_window = 0) Or (_format = Nil) Or (x = 0) Or + (y = 0) Or (w = 0) Or (h = 0) Then; +End; + +Procedure TX11DGADisplay.close; + +Begin + If m_indirect Then + Begin + m_indirect := False; + XF86DGADirectVideo(m_disp, m_screen, 0); + End; + +// Writeln('lala1'); + If m_inmode Then + Begin + m_inmode := False; + XF86VidModeSwitchToMode(m_disp, m_screen, modeinfo[previousmode]); + XUngrabKeyboard(m_disp, CurrentTime); + XUngrabPointer(m_disp, CurrentTime); + End; + +// Writeln('lala2'); + If m_disp <> Nil Then + XFlush(m_disp); +// Writeln('lala3'); + + If m_cmap <> 0 Then + Begin + XFreeColormap(m_disp, m_cmap); + m_cmap := 0; + End; + +// Writeln('lala4'); + FreeMemAndNil(m_colours); + +// Writeln('lala5'); + If modeinfo <> Nil Then + Begin + XFree(modeinfo); + modeinfo := Nil; + End; +// Writeln('lala6'); +End; + +Procedure TX11DGADisplay.update; + +Begin +End; + +Procedure TX11DGADisplay.update(Const _area : TPTCArea); + +Begin +End; + +Procedure TX11DGADisplay.HandleEvents; + +Var + e : TXEvent; + NewFocus : Boolean; + NewFocusSpecified : Boolean; + + Function UsefulEventsPending : Boolean; + + Var + tmpEvent : TXEvent; + + Begin + If XCheckTypedEvent(m_disp, ClientMessage, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(m_disp, @tmpEvent); + Exit; + End; + + If XCheckMaskEvent(m_disp, FocusChangeMask Or + KeyPressMask Or KeyReleaseMask Or + ButtonPressMask Or ButtonReleaseMask Or + PointerMotionMask Or ExposureMask, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(m_disp, @tmpEvent); + Exit; + End; + + Result := False; + End; + + Procedure HandleKeyEvent; + + Var + sym : TKeySym; + sym_modded : TKeySym; { modifiers like shift are taken into account here } + press : Boolean; + alt, shift, ctrl : Boolean; + uni : Integer; + key : TPTCKeyEvent; + buf : Array[1..16] Of Char; + + Begin + sym := XLookupKeySym(@e.xkey, 0); + XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil); + uni := X11ConvertKeySymToUnicode(sym_modded); + alt := (e.xkey.state And Mod1Mask) <> 0; + shift := (e.xkey.state And ShiftMask) <> 0; + ctrl := (e.xkey.state And ControlMask) <> 0; + If e._type = KeyPress Then + press := True + Else + press := False; + + key := Nil; + Case sym Shr 8 Of + 0 : key := TPTCKeyEvent.Create(m_normalkeys[sym And $FF], uni, alt, shift, ctrl, press); + $FF : key := TPTCKeyEvent.Create(m_functionkeys[sym And $FF], uni, alt, shift, ctrl, press); + Else + key := TPTCKeyEvent.Create; + End; + FEventQueue.AddEvent(key); + End; + +Begin + NewFocusSpecified := False; + While UsefulEventsPending Do + Begin + XNextEvent(m_disp, @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]) = m_atom_close) Then + Halt(0);} + End; + Expose : Begin + {...} + End; + KeyPress, KeyRelease : HandleKeyEvent; + ButtonPress, ButtonRelease : Begin + {...} + End; + MotionNotify : Begin + {...} + End; + End; + End; +// HandleChangeFocus(NewFocus); +End; + +Function TX11DGADisplay.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; + +Var + tmpEvent : TXEvent; + +Begin + FreeAndNil(event); + Repeat + { process all events from the X queue and put them on our FEventQueue } + HandleEvents; + + { try to find an event that matches the EventMask } + event := FEventQueue.NextEvent(EventMask); + + If wait And (event = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(m_disp, @tmpEvent); + End; + Until (Not Wait) Or (event <> Nil); + Result := event <> Nil; +End; + +Function TX11DGADisplay.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; + +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(EventMask); + + If wait And (Result = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(m_disp, @tmpEvent); + End; + Until (Not Wait) Or (Result <> Nil); +End; + + +Function TX11DGADisplay.lock : Pointer; + +Begin + lock := dga_addr + dga_linewidth * m_desty * (m_format.bits Div 8) + + m_destx * (m_format.bits Div 8); +End; + +Procedure TX11DGADisplay.unlock; + +Begin +End; + +Procedure TX11DGADisplay.palette(Const _palette : TPTCPalette); + +Var + pal : PUint32; + i : Integer; + +Begin + pal := _palette.data; + If Not m_format.indexed Then + Exit; + For i := 0 To 255 Do + Begin + m_colours[i].pixel := i; + + m_colours[i].red := ((pal[i] Shr 16) And $FF) Shl 8; + m_colours[i].green := ((pal[i] Shr 8) And $FF) Shl 8; + m_colours[i].blue := (pal[i] And $FF) Shl 8; + + Byte(m_colours[i].flags) := DoRed Or DoGreen Or DoBlue; + End; + XStoreColors(m_disp, m_cmap, m_colours, 256); + XF86DGAInstallColormap(m_disp, m_screen, m_cmap); +End; + +Function TX11DGADisplay.pitch : Integer; + +Begin + pitch := dga_linewidth * (m_format.bits Div 8); +End; + +Function TX11DGADisplay.getX11Window : TWindow; + +Begin + Result := DefaultRootWindow(m_disp); +End; + +Function TX11DGADisplay.isFullScreen : Boolean; + +Begin + { DGA is always fullscreen } + Result := True; +End; + +Procedure TX11DGADisplay.SetCursor(visible : Boolean); + +Begin + {nothing... raise exception if visible=true?} +End; diff --git a/packages/ptc/src/x11/x11displayd.inc b/packages/ptc/src/x11/x11displayd.inc new file mode 100644 index 0000000000..9848461d1a --- /dev/null +++ b/packages/ptc/src/x11/x11displayd.inc @@ -0,0 +1,129 @@ +Type + TX11FlagsEnum = (PTC_X11_FULLSCREEN, + PTC_X11_LEAVE_DISPLAY, + PTC_X11_LEAVE_WINDOW, + PTC_X11_TRY_DGA, + PTC_X11_TRY_XF86VIDMODE, + PTC_X11_TRY_XRANDR, + PTC_X11_TRY_XSHM, + PTC_X11_DITHER, + PTC_X11_FULLSCREEN_CURSOR_VISIBLE, + PTC_X11_WINDOWED_CURSOR_INVISIBLE); + TX11Flags = Set Of TX11FlagsEnum; + +Type + TX11Display = Class(TObject) + Protected + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Virtual; Abstract; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Virtual; Abstract; + + Function GetX11Format(Const AFormat : TPTCFormat) : TPTCFormat; + + { initialise the keyboard mapping table } + Procedure SetKeyMapping; + + { Data access } + Function GetWidth : Integer; + Function GetHeight : Integer; + Function GetPitch : Integer; Virtual; Abstract; + Function GetFormat : TPTCFormat; + Function GetArea : TPTCArea; + + { Conversion object } + FCopy : TPTCCopy; + FClear : TPTCClear; + FPalette : TPTCPalette; + + FArea : TPTCArea; + FClip : TPTCArea; + + FEventQueue : TEventQueue; + + FFlags : TX11Flags; + FWidth, FHeight : DWord; + FFormat : TPTCFormat; + + FDisplay : PDisplay; + FScreen : Integer; + + FCMap : TColormap; + FColours : PXColor; + + FFunctionKeys : PInteger; + FNormalKeys : PInteger; + + {m_thread : pthread_t;} + Public + Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Virtual; + Destructor Destroy; Override; + + Procedure Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); Virtual; Abstract; + + { This will always return a windowed console. The first version + fills the whole window, the second one has a custom size } + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat); Virtual; Abstract; + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); Virtual; Abstract; + + Procedure Close; Virtual; Abstract; + + Procedure Update; Virtual; Abstract; + Procedure Update(Const AArea : TPTCArea); Virtual; Abstract; + + Function Lock : Pointer; Virtual; Abstract; + Procedure Unlock; Virtual; Abstract; + + { load pixels to console } + Procedure Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette); Virtual; + Procedure Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Virtual; + + { save console pixels } + Procedure Save(APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette); Virtual; + Procedure Save(APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Virtual; + + { clear surface } + Procedure Clear(Const AColor : TPTCColor); Virtual; + Procedure Clear(Const AColor : TPTCColor; Const AArea : TPTCArea); Virtual; + + { Console palette } + Procedure Palette(Const APalette : TPTCPalette); Virtual; Abstract; + Function Palette : TPTCPalette; Virtual; + + { console clip area } + Procedure Clip(Const AArea : TPTCArea); + + { cursor control } + Procedure SetCursor(AVisible : Boolean); Virtual; Abstract; + + { Data access } + Function Clip : TPTCArea; + + Function IsFullScreen : Boolean; Virtual; Abstract; + + { Set flags (only used internally now!) } + Procedure SetFlags(AFlags : TX11Flags); + + Procedure GetModes(Var AModes : TPTCModeDynArray); Virtual; Abstract; + + { X11 helper functions for your enjoyment } + + { return the display we are using } + Function GetX11Display : PDisplay; + + { return the screen we are using } + Function GetX11Screen : Integer; + + { return our window (0 if DGA) } + Function GetX11Window : TWindow; Virtual; Abstract; + + Property Width : Integer Read GetWidth; + Property Height : Integer Read GetHeight; + Property Pitch : Integer Read GetPitch; + Property Area : TPTCArea Read GetArea; + Property Format : TPTCFormat Read GetFormat; + End; diff --git a/packages/ptc/src/x11/x11displayi.inc b/packages/ptc/src/x11/x11displayi.inc new file mode 100644 index 0000000000..f01e0fc990 --- /dev/null +++ b/packages/ptc/src/x11/x11displayi.inc @@ -0,0 +1,376 @@ +{$INCLUDE xunikey.inc} + +Constructor TX11Display.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); + +Begin + FFlags := AFlags; + + FDisplay := ADisplay; + FScreen := AScreen; + + FCopy := TPTCCopy.Create; + FClear := TPTCClear.Create; + FPalette := TPTCPalette.Create; + FClip := TPTCArea.Create; + FArea := TPTCArea.Create; + FFormat := TPTCFormat.Create; + FEventQueue := TEventQueue.Create; + + SetKeyMapping; +End; + +Destructor TX11Display.Destroy; + +Begin + { Just close the display, everything else is done by the subclasses } + If (FDisplay <> Nil) And (Not (PTC_X11_LEAVE_DISPLAY In FFlags)) Then + Begin + XFlush(FDisplay); + XCloseDisplay(FDisplay); + FDisplay := Nil; + End; + FreeMemAndNil(FNormalKeys); + FreeMemAndNil(FFunctionKeys); + + FCopy.Free; + FClear.Free; + FPalette.Free; + FClip.Free; + FArea.Free; + FFormat.Free; + FEventQueue.Free; + + Inherited Destroy; +End; + +Procedure TX11Display.Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + If Clip.Equals(Area) Then + Begin + Try + console_pixels := Lock; + Try + FCopy.Request(AFormat, Format); + FCopy.Palette(APalette, Palette); + FCopy.Copy(APixels, 0, 0, AWidth, AHeight, APitch, console_pixels, 0, 0, + Width, Height, Pitch); + Finally + Unlock; + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('failed to load pixels to console', error); + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area_, Area); + Finally + Area_.Free; + End; + End; +End; + +Procedure TX11Display.Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + clipped_source := Nil; + clipped_destination := Nil; + Try + console_pixels := Lock; + Try + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + tmp := TPTCArea.Create(0, 0, AWidth, AHeight); + Try + TPTCClipper.Clip(ASource, tmp, clipped_source, ADestination, Clip, clipped_destination); + Finally + tmp.Free; + End; + FCopy.request(AFormat, Format); + FCopy.palette(APalette, Palette); + FCopy.copy(APixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, APitch, + console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, Pitch); + Finally + Unlock; + clipped_source.Free; + clipped_destination.Free; + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('failed to load pixels to console area', error); + End; +End; + +Procedure TX11Display.Save(APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette); + +Begin +End; + +Procedure TX11Display.Save(APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); + +Begin +End; + +Procedure TX11Display.Clear(Const AColor : TPTCColor); + +Begin +End; + +Procedure TX11Display.Clear(Const AColor : TPTCColor; Const AArea : TPTCArea); + +Begin +End; + +Function TX11Display.Palette : TPTCPalette; + +Begin + Result := FPalette; +End; + +Procedure TX11Display.Clip(Const AArea : TPTCArea); + +Begin + FClip.Assign(AArea); +End; + +Function TX11Display.GetWidth : Integer; + +Begin + Result := FWidth; +End; + +Function TX11Display.GetHeight : Integer; + +Begin + Result := FHeight; +End; + +Function TX11Display.Clip : TPTCArea; + +Begin + Result := FClip; +End; + +Function TX11Display.GetArea : TPTCArea; + +Var + tmp : TPTCArea; + +Begin + tmp := TPTCArea.Create(0, 0, FWidth, FHeight); + Try + FArea.Assign(tmp); + Finally + tmp.Free; + End; + Result := FArea; +End; + +Function TX11Display.GetFormat : TPTCFormat; + +Begin + Result := FFormat; +End; + +Procedure TX11Display.SetFlags(AFlags : TX11Flags); + +Begin + FFlags := AFlags; +End; + +Function TX11Display.GetX11Display : PDisplay; + +Begin + Result := FDisplay; +End; + +Function TX11Display.GetX11Screen : Integer; + +Begin + Result := FScreen; +End; + +Function TX11Display.GetX11Format(Const AFormat : TPTCFormat) : TPTCFormat; + +Var + tmp_depth : Integer; + numfound : Integer; + i : Integer; + pfv : PXPixmapFormatValues; + +Begin + Result := Nil; + + { Check if our screen has the same format available. I hate how X } + { keeps bits_per_pixel and depth different } + tmp_depth := DisplayPlanes(FDisplay, FScreen); + + pfv := XListPixmapFormats(FDisplay, @numfound); + Try + For i := 0 To numfound - 1 Do + Begin + If pfv[i].depth = tmp_depth Then + Begin + tmp_depth := pfv[i].bits_per_pixel; + Break; + End; + End; + Finally + XFree(pfv); + End; + + If (tmp_depth = 8) And AFormat.Indexed Then + Result := TPTCFormat.Create(8) + Else + If (tmp_depth = 8) And AFormat.Direct Then + Result := TPTCFormat.Create(8, $E0, $1C, $03) + Else + Result := TPTCFormat.Create(tmp_depth, + DefaultVisual(FDisplay, FScreen)^.red_mask, + DefaultVisual(FDisplay, FScreen)^.green_mask, + DefaultVisual(FDisplay, FScreen)^.blue_mask); +End; + +Procedure TX11Display.SetKeyMapping; + +Var + _I : Integer; + +Begin + FreeMemAndNil(FFunctionKeys); + FreeMemAndNil(FNormalKeys); + FFunctionKeys := GetMem(256 * SizeOf(Integer)); + FNormalKeys := GetMem(256 * SizeOf(Integer)); + + For _I := 0 To 255 Do + Begin + FFunctionKeys[_I] := Integer(PTCKEY_UNDEFINED); + FNormalKeys[_I] := Integer(PTCKEY_UNDEFINED); + End; + + { Assign function key indices from X definitions } + FFunctionKeys[$FF And XK_BackSpace] := Integer(PTCKEY_BACKSPACE); + FFunctionKeys[$FF And XK_Tab] := Integer(PTCKEY_TAB); + FFunctionKeys[$FF And XK_Clear] := Integer(PTCKEY_CLEAR); + FFunctionKeys[$FF And XK_Return] := Integer(PTCKEY_ENTER); + FFunctionKeys[$FF And XK_Pause] := Integer(PTCKEY_PAUSE); + FFunctionKeys[$FF And XK_Scroll_Lock] := Integer(PTCKEY_SCROLLLOCK); + FFunctionKeys[$FF And XK_Escape] := Integer(PTCKEY_ESCAPE); + FFunctionKeys[$FF And XK_Delete] := Integer(PTCKEY_DELETE); + + FFunctionKeys[$FF And XK_Kanji] := Integer(PTCKEY_KANJI); + + FFunctionKeys[$FF And XK_Home] := Integer(PTCKEY_HOME); + FFunctionKeys[$FF And XK_Left] := Integer(PTCKEY_LEFT); + FFunctionKeys[$FF And XK_Up] := Integer(PTCKEY_UP); + FFunctionKeys[$FF And XK_Right] := Integer(PTCKEY_RIGHT); + FFunctionKeys[$FF And XK_Down] := Integer(PTCKEY_DOWN); + FFunctionKeys[$FF And XK_Page_Up] := Integer(PTCKEY_PAGEUP); + FFunctionKeys[$FF And XK_Page_Down] := Integer(PTCKEY_PAGEDOWN); + FFunctionKeys[$FF And XK_End] := Integer(PTCKEY_END); + + FFunctionKeys[$FF And XK_Print] := Integer(PTCKEY_PRINTSCREEN); + FFunctionKeys[$FF And XK_Insert] := Integer(PTCKEY_INSERT); + FFunctionKeys[$FF And XK_Num_Lock] := Integer(PTCKEY_NUMLOCK); + + FFunctionKeys[$FF And XK_KP_0] := Integer(PTCKEY_NUMPAD0); + FFunctionKeys[$FF And XK_KP_1] := Integer(PTCKEY_NUMPAD1); + FFunctionKeys[$FF And XK_KP_2] := Integer(PTCKEY_NUMPAD2); + FFunctionKeys[$FF And XK_KP_3] := Integer(PTCKEY_NUMPAD3); + FFunctionKeys[$FF And XK_KP_4] := Integer(PTCKEY_NUMPAD4); + FFunctionKeys[$FF And XK_KP_5] := Integer(PTCKEY_NUMPAD5); + FFunctionKeys[$FF And XK_KP_6] := Integer(PTCKEY_NUMPAD6); + FFunctionKeys[$FF And XK_KP_7] := Integer(PTCKEY_NUMPAD7); + FFunctionKeys[$FF And XK_KP_8] := Integer(PTCKEY_NUMPAD8); + FFunctionKeys[$FF And XK_KP_9] := Integer(PTCKEY_NUMPAD9); + + FFunctionKeys[$FF And XK_F1] := Integer(PTCKEY_F1); + FFunctionKeys[$FF And XK_F2] := Integer(PTCKEY_F2); + FFunctionKeys[$FF And XK_F3] := Integer(PTCKEY_F3); + FFunctionKeys[$FF And XK_F4] := Integer(PTCKEY_F4); + FFunctionKeys[$FF And XK_F5] := Integer(PTCKEY_F5); + FFunctionKeys[$FF And XK_F6] := Integer(PTCKEY_F6); + FFunctionKeys[$FF And XK_F7] := Integer(PTCKEY_F7); + FFunctionKeys[$FF And XK_F8] := Integer(PTCKEY_F8); + FFunctionKeys[$FF And XK_F9] := Integer(PTCKEY_F9); + FFunctionKeys[$FF And XK_F10] := Integer(PTCKEY_F10); + FFunctionKeys[$FF And XK_F11] := Integer(PTCKEY_F11); + FFunctionKeys[$FF And XK_F12] := Integer(PTCKEY_F12); + + FFunctionKeys[$FF And XK_Shift_L] := Integer(PTCKEY_SHIFT); + FFunctionKeys[$FF And XK_Shift_R] := Integer(PTCKEY_SHIFT); + FFunctionKeys[$FF And XK_Control_L] := Integer(PTCKEY_CONTROL); + FFunctionKeys[$FF And XK_Control_R] := Integer(PTCKEY_CONTROL); + FFunctionKeys[$FF And XK_Caps_Lock] := Integer(PTCKEY_CAPSLOCK); + FFunctionKeys[$FF And XK_Meta_L] := Integer(PTCKEY_META); + FFunctionKeys[$FF And XK_Meta_R] := Integer(PTCKEY_META); + FFunctionKeys[$FF And XK_Alt_L] := Integer(PTCKEY_ALT); + FFunctionKeys[$FF And XK_Alt_R] := Integer(PTCKEY_ALT); + + { Assign normal key indices } + FNormalKeys[$FF And XK_space] := Integer(PTCKEY_SPACE); + FNormalKeys[$FF And XK_comma] := Integer(PTCKEY_COMMA); + FNormalKeys[$FF And XK_minus] := Integer(PTCKEY_SUBTRACT); + FNormalKeys[$FF And XK_period] := Integer(PTCKEY_PERIOD); + FNormalKeys[$FF And XK_slash] := Integer(PTCKEY_SLASH); + FNormalKeys[$FF And XK_0] := Integer(PTCKEY_ZERO); + FNormalKeys[$FF And XK_1] := Integer(PTCKEY_ONE); + FNormalKeys[$FF And XK_2] := Integer(PTCKEY_TWO); + FNormalKeys[$FF And XK_3] := Integer(PTCKEY_THREE); + FNormalKeys[$FF And XK_4] := Integer(PTCKEY_FOUR); + FNormalKeys[$FF And XK_5] := Integer(PTCKEY_FIVE); + FNormalKeys[$FF And XK_6] := Integer(PTCKEY_SIX); + FNormalKeys[$FF And XK_7] := Integer(PTCKEY_SEVEN); + FNormalKeys[$FF And XK_8] := Integer(PTCKEY_EIGHT); + FNormalKeys[$FF And XK_9] := Integer(PTCKEY_NINE); + FNormalKeys[$FF And XK_semicolon] := Integer(PTCKEY_SEMICOLON); + FNormalKeys[$FF And XK_equal] := Integer(PTCKEY_EQUALS); + + FNormalKeys[$FF And XK_bracketleft] := Integer(PTCKEY_OPENBRACKET); + FNormalKeys[$FF And XK_backslash] := Integer(PTCKEY_BACKSLASH); + FNormalKeys[$FF And XK_bracketright] := Integer(PTCKEY_CLOSEBRACKET); + + FNormalKeys[$FF And XK_a] := Integer(PTCKEY_A); + FNormalKeys[$FF And XK_b] := Integer(PTCKEY_B); + FNormalKeys[$FF And XK_c] := Integer(PTCKEY_C); + FNormalKeys[$FF And XK_d] := Integer(PTCKEY_D); + FNormalKeys[$FF And XK_e] := Integer(PTCKEY_E); + FNormalKeys[$FF And XK_f] := Integer(PTCKEY_F); + FNormalKeys[$FF And XK_g] := Integer(PTCKEY_G); + FNormalKeys[$FF And XK_h] := Integer(PTCKEY_H); + FNormalKeys[$FF And XK_i] := Integer(PTCKEY_I); + FNormalKeys[$FF And XK_j] := Integer(PTCKEY_J); + FNormalKeys[$FF And XK_k] := Integer(PTCKEY_K); + FNormalKeys[$FF And XK_l] := Integer(PTCKEY_L); + FNormalKeys[$FF And XK_m] := Integer(PTCKEY_M); + FNormalKeys[$FF And XK_n] := Integer(PTCKEY_N); + FNormalKeys[$FF And XK_o] := Integer(PTCKEY_O); + FNormalKeys[$FF And XK_p] := Integer(PTCKEY_P); + FNormalKeys[$FF And XK_q] := Integer(PTCKEY_Q); + FNormalKeys[$FF And XK_r] := Integer(PTCKEY_R); + FNormalKeys[$FF And XK_s] := Integer(PTCKEY_S); + FNormalKeys[$FF And XK_t] := Integer(PTCKEY_T); + FNormalKeys[$FF And XK_u] := Integer(PTCKEY_U); + FNormalKeys[$FF And XK_v] := Integer(PTCKEY_V); + FNormalKeys[$FF And XK_w] := Integer(PTCKEY_W); + FNormalKeys[$FF And XK_x] := Integer(PTCKEY_X); + FNormalKeys[$FF And XK_y] := Integer(PTCKEY_Y); + FNormalKeys[$FF And XK_z] := Integer(PTCKEY_Z); +End; diff --git a/packages/ptc/src/x11/x11imaged.inc b/packages/ptc/src/x11/x11imaged.inc new file mode 100644 index 0000000000..3a5ee7268d --- /dev/null +++ b/packages/ptc/src/x11/x11imaged.inc @@ -0,0 +1,46 @@ +Type + TX11Image = Class(TObject) + Protected + FWidth, FHeight : Integer; + FDisplay : PDisplay; + FImage : PXImage; + Public + Constructor Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); Virtual; + Procedure Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); Virtual; Abstract; + Procedure Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY, + AWidth, AHeight : Integer); Virtual; Abstract; + Function Lock : Pointer; Virtual; Abstract; + Function Pitch : Integer; Virtual; Abstract; + Function Name : String; Virtual; Abstract; + End; + + TX11NormalImage = Class(TX11Image) + Private + FPixels : PUint8; + Public + Constructor Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); Override; + Destructor Destroy; Override; + Procedure Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); Override; + Procedure Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY, + AWidth, AHeight : Integer); Override; + Function Lock : Pointer; Override; + Function Pitch : Integer; Override; + Function Name : String; Override; + End; + +{$IFDEF ENABLE_X11_EXTENSION_XSHM} + TX11ShmImage = Class(TX11Image) + Private + FShmInfo : TXShmSegmentInfo; + FShmAttached : Boolean; + Public + Constructor Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); Override; + Destructor Destroy; Override; + Procedure Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); Override; + Procedure Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY, + AWidth, AHeight : Integer); Override; + Function Lock : Pointer; Override; + Function Pitch : Integer; Override; + Function Name : String; Override; + End; +{$ENDIF ENABLE_X11_EXTENSION_XSHM} diff --git a/packages/ptc/src/x11/x11imagei.inc b/packages/ptc/src/x11/x11imagei.inc new file mode 100644 index 0000000000..2050999de0 --- /dev/null +++ b/packages/ptc/src/x11/x11imagei.inc @@ -0,0 +1,197 @@ +Const +{$WARNING this belongs to the ipc unit} + IPC_PRIVATE = 0; + +Constructor TX11Image.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); + +Begin + FWidth := AWidth; + FHeight := AHeight; + FDisplay := ADisplay; +End; + +Constructor TX11NormalImage.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); + +Var + xpad, xpitch : Integer; + tmp_FPixels : PChar; + +Begin + Inherited; + + xpad := AFormat.Bits; + If AFormat.Bits = 24 Then + xpad := 32; + xpitch := AWidth * AFormat.Bits Div 8; + Inc(xpitch, 3); + xpitch := xpitch And (Not 3); + FPixels := GetMem(xpitch * AHeight); + Pointer(tmp_FPixels) := Pointer(FPixels); + FImage := XCreateImage(ADisplay, DefaultVisual(ADisplay, AScreen), + DefaultDepth(ADisplay, AScreen), + ZPixmap, 0, tmp_FPixels, + AWidth, AHeight, xpad, 0); + If FImage = Nil Then + Raise TPTCError.Create('cannot create XImage'); +End; + +Destructor TX11NormalImage.Destroy; + +Begin + If FImage <> Nil Then + Begin + { Restore XImage's buffer pointer } + FImage^.data := Nil; + XDestroyImage(FImage); + End; + + If FPixels <> Nil Then + FreeMem(FPixels); + + Inherited Destroy; +End; + +Procedure TX11NormalImage.Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); + +Begin + XPutImage(FDisplay, AWindow, AGC, FImage, 0, 0, AX, AY, FWidth, FHeight); + XSync(FDisplay, False); +End; + +Procedure TX11NormalImage.Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY, + AWidth, AHeight : Integer); + +Begin + XPutImage(FDisplay, AWindow, AGC, FImage, ASX, ASY, ADX, ADY, AWidth, AHeight); + XSync(FDisplay, False); +End; + +Function TX11NormalImage.Lock : Pointer; + +Begin + Result := FPixels; +End; + +Function TX11NormalImage.Pitch : Integer; + +Begin + Result := FImage^.bytes_per_line; +End; + +Function TX11NormalImage.Name : String; + +Begin + Result := 'XImage'; +End; + +{$IFDEF ENABLE_X11_EXTENSION_XSHM} + +Var + Fshm_error : Boolean; + Fshm_oldhandler : Function(disp : PDisplay; xev : PXErrorEvent) : Integer; CDecl; + +Function Fshm_errorhandler(disp : PDisplay; xev : PXErrorEvent) : Integer; CDecl; + +Begin + If xev^.error_code=BadAccess Then + Begin + Fshm_error := True; + Result := 0; + End + Else + Result := Fshm_oldhandler(disp, xev); +End; + +Constructor TX11ShmImage.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); + +Begin + Inherited; + + FShmInfo.shmid := -1; + FShmInfo.shmaddr := Pointer(-1); + FImage := XShmCreateImage(ADisplay, DefaultVisual(ADisplay, AScreen), + DefaultDepth(ADisplay, AScreen), + ZPixmap, Nil, @FShmInfo, AWidth, AHeight); + If FImage = Nil Then + Raise TPTCError.Create('cannot create SHM image'); + + FShmInfo.shmid := shmget(IPC_PRIVATE, FImage^.bytes_per_line * FImage^.height, + IPC_CREAT Or &777); + If FShmInfo.shmid = -1 Then + Raise TPTCError.Create('cannot get shared memory segment'); + + FShmInfo.shmaddr := shmat(FShmInfo.shmid, Nil, 0); + FShmInfo.readOnly := False; + FImage^.data := FShmInfo.shmaddr; + + If Pointer(FShmInfo.shmaddr) = Pointer(-1) Then + Raise TPTCError.Create('cannot allocate shared memory'); + + // Try and attach the segment to the server. Bugfix: Have to catch + // bad access errors in case it runs over the net. + Fshm_error := False; + Fshm_oldhandler := XSetErrorHandler(@Fshm_errorhandler); + Try + If XShmAttach(ADisplay, @FShmInfo) = 0 Then + Raise TPTCError.Create('cannot attach shared memory segment to display'); + + XSync(ADisplay, False); + If Fshm_error Then + Raise TPTCError.Create('cannot attach shared memory segment to display'); + FShmAttached := True; + Finally + XSetErrorHandler(Fshm_oldhandler); + End; +End; + +Destructor TX11ShmImage.Destroy; + +Begin + If FShmAttached Then + Begin + XShmDetach(FDisplay, @FShmInfo); + XSync(FDisplay, False); + End; + If FImage <> Nil Then + XDestroyImage(FImage); + If Pointer(FShmInfo.shmaddr) <> Pointer(-1) Then + shmdt(FShmInfo.shmaddr); + If FShmInfo.shmid <> -1 Then + shmctl(FShmInfo.shmid, IPC_RMID, Nil); + + Inherited Destroy; +End; + +Procedure TX11ShmImage.Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); + +Begin + XShmPutImage(FDisplay, AWindow, AGC, FImage, 0, 0, AX, AY, FWidth, FHeight, False); + XSync(FDisplay, False); +End; + +Procedure TX11ShmImage.Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY, + AWidth, AHeight : Integer); + +Begin + XShmPutImage(FDisplay, AWindow, AGC, FImage, ASX, ASY, ADX, ADY, FWidth, FHeight, False); + XSync(FDisplay, False); +End; + +Function TX11ShmImage.Lock : Pointer; + +Begin + Result := Pointer(FShmInfo.shmaddr); +End; + +Function TX11ShmImage.Pitch : Integer; + +Begin + Result := FImage^.bytes_per_line; +End; + +Function TX11ShmImage.Name : String; + +Begin + Result := 'MIT-Shm'; +End; +{$ENDIF ENABLE_X11_EXTENSION_XSHM} diff --git a/packages/ptc/src/x11/x11modesd.inc b/packages/ptc/src/x11/x11modesd.inc new file mode 100644 index 0000000000..39ff7f3c4a --- /dev/null +++ b/packages/ptc/src/x11/x11modesd.inc @@ -0,0 +1,69 @@ +Type + TX11Modes = Class(TObject) + Private + FDisplay : PDisplay; + FScreen : cint; + Protected + Function GetWidth : Integer; Virtual; Abstract; + Function GetHeight : Integer; Virtual; Abstract; + Public + Constructor Create(ADisplay : PDisplay; AScreen : cint); Virtual; + Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Virtual; Abstract; + Procedure SetBestMode(AWidth, AHeight : Integer); Virtual; Abstract; + Procedure RestorePreviousMode; Virtual; Abstract; + Property Width : Integer Read GetWidth; + Property Height : Integer Read GetHeight; + End; + + TX11ModesNoModeSwitching = Class(TX11Modes) + Private + FWidth, FHeight : Integer; + Protected + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Public + Constructor Create(ADisplay : PDisplay; AScreen : cint); Override; + Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Override; + Procedure SetBestMode(AWidth, AHeight : Integer); Override; + Procedure RestorePreviousMode; Override; + End; + +{$IFDEF ENABLE_X11_EXTENSION_XRANDR} + TX11ModesXrandr = Class(TX11Modes) + Private + FRoot : TWindow; + FXRRConfig : PXRRScreenConfiguration; + Protected + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Public + Constructor Create(ADisplay : PDisplay; AScreen : cint); Override; + Destructor Destroy; Override; + Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Override; + Procedure SetBestMode(AWidth, AHeight : Integer); Override; + Procedure RestorePreviousMode; Override; + End; +{$ENDIF ENABLE_X11_EXTENSION_XRANDR} + +{$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE} + TX11ModesXF86VidMode = Class(TX11Modes) + Private + FModeList : PPXF86VidModeModeInfo; + FModeListCount : cint; + FSavedMode : PXF86VidModeModeLine; + FSavedDotClock : cint; + FWidth, FHeight : Integer; + + Procedure RetrieveModeList; + Function FindNumberOfBestMode(AWidth, AHeight : Integer) : Integer; + Protected + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Public + Constructor Create(ADisplay : PDisplay; AScreen : cint); Override; + Destructor Destroy; Override; + Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Override; + Procedure SetBestMode(AWidth, AHeight : Integer); Override; + Procedure RestorePreviousMode; Override; + End; +{$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE} diff --git a/packages/ptc/src/x11/x11modesi.inc b/packages/ptc/src/x11/x11modesi.inc new file mode 100644 index 0000000000..15846c0d7c --- /dev/null +++ b/packages/ptc/src/x11/x11modesi.inc @@ -0,0 +1,291 @@ +Constructor TX11Modes.Create(ADisplay : PDisplay; AScreen : cint); + +Begin + FDisplay := ADisplay; + FScreen := AScreen; +End; + +Constructor TX11ModesNoModeSwitching.Create(ADisplay : PDisplay; AScreen : cint); + +Begin + Inherited; + + FWidth := DisplayWidth(FDisplay, FScreen); + FHeight := DisplayHeight(FDisplay, FScreen); +End; + +Procedure TX11ModesNoModeSwitching.GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); + +Begin + SetLength(AModes, 2); + AModes[0] := TPTCMode.Create(FWidth, + FHeight, + ACurrentDesktopFormat); + AModes[1] := TPTCMode.Create; +End; + +Procedure TX11ModesNoModeSwitching.SetBestMode(AWidth, AHeight : Integer); + +Begin + FWidth := DisplayWidth(FDisplay, FScreen); + FHeight := DisplayHeight(FDisplay, FScreen); +End; + +Procedure TX11ModesNoModeSwitching.RestorePreviousMode; + +Begin + { do nothing } +End; + +Function TX11ModesNoModeSwitching.GetWidth : Integer; + +Begin + Result := FWidth; +End; + +Function TX11ModesNoModeSwitching.GetHeight : Integer; + +Begin + Result := FHeight; +End; + +{$IFDEF ENABLE_X11_EXTENSION_XRANDR} +Constructor TX11ModesXrandr.Create(ADisplay : PDisplay; AScreen : cint); + +Var + dummy1, dummy2 : cint; + Major, Minor : cint; + +Begin + Inherited; + + If Not XRRQueryExtension(FDisplay, @dummy1, @dummy2) Then + Raise TPTCError.Create('Xrandr extension not available'); + + XRRQueryVersion(FDisplay, @Major, @Minor); // todo: check + LOG('Xrandr version: ' + IntToStr(Major) + '.' + IntToStr(Minor)); + + FRoot := RootWindow(FDisplay, FScreen); + + FXRRConfig := XRRGetScreenInfo(FDisplay, FRoot); + If FXRRConfig = Nil Then + Raise TPTCError.Create('XRRGetScreenInfo failed'); + + Raise TPTCError.Create('Xrandr mode switcher is not yet implemented...'); +End; + +Destructor TX11ModesXrandr.Destroy; + +Begin + If FXRRConfig <> Nil Then + XRRFreeScreenConfigInfo(FXRRConfig); + + Inherited; +End; + +Procedure TX11ModesXrandr.GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); + +Begin + {...} +End; + +Procedure TX11ModesXrandr.SetBestMode(AWidth, AHeight : Integer); + +Begin + {todo...} +End; + +Procedure TX11ModesXrandr.RestorePreviousMode; + +Begin + {todo...} +End; + +Function TX11ModesXrandr.GetWidth : Integer; + +Begin + // todo... +End; + +Function TX11ModesXrandr.GetHeight : Integer; + +Begin + // todo... +End; +{$ENDIF ENABLE_X11_EXTENSION_XRANDR} + +{$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE} +Constructor TX11ModesXF86VidMode.Create(ADisplay : PDisplay; AScreen : Integer); + +Var + dummy1, dummy2 : cint; + +Begin + Inherited; + + FSavedMode := Nil; + FSavedDotClock := 0; + FModeList := Nil; + FModeListCount := 0; + + If Not XF86VidModeQueryExtension(FDisplay, @dummy1, @dummy2) Then + Raise TPTCError.Create('VidMode extension not available'); +End; + +Destructor TX11ModesXF86VidMode.Destroy; + +Begin + If FSavedMode <> Nil Then + Begin + RestorePreviousMode; + If FSavedMode^.privsize <> 0 Then + XFree(FSavedMode^.c_private); + Dispose(FSavedMode); + End; + + If FModeList <> Nil Then + XFree(FModeList); + + Inherited Destroy; +End; + +{todo: move the saving of the previous mode to a separate function...} +Procedure TX11ModesXF86VidMode.RetrieveModeList; + +Begin + { If we have been called before, do nothing } + If FModeList <> Nil Then + Exit; + + { Save previous mode } + New(FSavedMode); + FillChar(FSavedMode^, SizeOf(FSavedMode^), 0); + XF86VidModeGetModeLine(FDisplay, FScreen, @FSavedDotClock, FSavedMode); + + { Get all available video modes } + XF86VidModeGetAllModeLines(FDisplay, FScreen, @FModeListCount, @FModeList); +End; + +Procedure TX11ModesXF86VidMode.GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); + +Var + I : Integer; + +Begin + RetrieveModeList; + + SetLength(AModes, FModeListCount + 1); + AModes[FModeListCount] := TPTCMode.Create; + For I := 0 To FModeListCount - 1 Do + AModes[I] := TPTCMode.Create(FModeList[I]^.hdisplay, FModeList[I]^.vdisplay, ACurrentDesktopFormat); +End; + +Function TX11ModesXF86VidMode.FindNumberOfBestMode(AWidth, AHeight : Integer) : Integer; + +Var + min_diff : Integer; + d_x, d_y : Integer; + found_mode : Integer; + I : Integer; + +Begin + { Try an exact match } + For I := 0 To FModeListCount - 1 Do + If (FModeList[I]^.hdisplay = AWidth) And (FModeList[I]^.vdisplay = AHeight) Then + Exit(I); + + { Try to find a mode that matches the width first } + For I := 0 To FModeListCount - 1 Do + If (FModeList[I]^.hdisplay = AWidth) And (FModeList[I]^.vdisplay >= AHeight) Then + Exit(I); + + { Next try to match the height } + For I := 0 To FModeListCount - 1 Do + If (FModeList[I]^.hdisplay >= AWidth) And (FModeList[I]^.vdisplay = AHeight) Then + Exit(I); + + { Finally, find the mode that is bigger than the requested one and makes } + { the least difference } + found_mode := -1; + min_diff := High(Integer); + For I := 0 To FModeListCount - 1 Do + If (FModeList[I]^.hdisplay >= AWidth) And (FModeList[I]^.vdisplay >= AHeight) Then + Begin + d_x := Sqr(FModeList[I]^.hdisplay - AWidth); + d_y := Sqr(FModeList[I]^.vdisplay - AHeight); + If (d_x + d_y) < min_diff Then + Begin + min_diff := d_x + d_y; + found_mode := I; + End; + End; + + If found_mode <> -1 Then + Result := found_mode + Else + Raise TPTCError.Create('Cannot find matching video mode'); +End; + +Procedure TX11ModesXF86VidMode.SetBestMode(AWidth, AHeight : Integer); + +Var + BestMode : Integer; + +Begin + RetrieveModeList; + + BestMode := FindNumberOfBestMode(AWidth, AHeight); + If Not XF86VidModeSwitchToMode(FDisplay, FScreen, FModeList[BestMode]) Then + Raise TPTCError.Create('Error switching to the requested video mode'); + + FWidth := FModeList[BestMode]^.hdisplay; + FHeight := FModeList[BestMode]^.vdisplay; + + XWarpPointer(FDisplay, None, RootWindow(FDisplay, FScreen), 0, 0, 0, 0, + FWidth Div 2, + FHeight Div 2); + + If Not XF86VidModeSetViewPort(FDisplay, FScreen, 0, 0) Then + Raise TPTCError.Create('Error moving the viewport to the upper-left corner'); +End; + +Procedure TX11ModesXF86VidMode.RestorePreviousMode; + +Var + ModeInfo : TXF86VidModeModeInfo; + +Begin + If FSavedMode <> Nil Then + Begin + {FSavedMode is a TXF86VidModeModeLine, but XF86VidModeSwitchToMode wants a + TXF86VidModeModeInfo :} + FillChar(ModeInfo, SizeOf(ModeInfo), 0); + ModeInfo.dotclock := FSavedDotClock; + ModeInfo.hdisplay := FSavedMode^.hdisplay; + ModeInfo.hsyncstart := FSavedMode^.hsyncstart; + ModeInfo.hsyncend := FSavedMode^.hsyncend; + ModeInfo.htotal := FSavedMode^.htotal; + ModeInfo.vdisplay := FSavedMode^.vdisplay; + ModeInfo.vsyncstart := FSavedMode^.vsyncstart; + ModeInfo.vsyncend := FSavedMode^.vsyncend; + ModeInfo.vtotal := FSavedMode^.vtotal; + ModeInfo.flags := FSavedMode^.flags; + ModeInfo.privsize := FSavedMode^.privsize; + ModeInfo.c_private := FSavedMode^.c_private; + + XF86VidModeSwitchToMode(FDisplay, FScreen, @ModeInfo); + End; +End; + +Function TX11ModesXF86VidMode.GetWidth : Integer; + +Begin + Result := FWidth; +End; + +Function TX11ModesXF86VidMode.GetHeight : Integer; + +Begin + Result := FHeight; +End; +{$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE} diff --git a/packages/ptc/src/x11/x11windowdisplayd.inc b/packages/ptc/src/x11/x11windowdisplayd.inc new file mode 100644 index 0000000000..b065d7bd0b --- /dev/null +++ b/packages/ptc/src/x11/x11windowdisplayd.inc @@ -0,0 +1,52 @@ +Type + TX11WindowDisplay = Class(TX11Display) + Private + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override; + + Procedure EnterFullScreen; + Procedure LeaveFullScreen; + Procedure internal_ShowCursor(AVisible : Boolean); + Procedure HandleChangeFocus(ANewFocus : Boolean); + Procedure HandleEvents; + Function CreateImage(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; + AFormat : TPTCFormat) : TX11Image; { Factory method } + Function CreateModeSwitcher : TX11Modes; { Factory method } + Procedure CreateColormap; { Register colour maps } + {eventHandler} + FWindow : TWindow; + FPrimary : TX11Image; + FDestX, FDestY : Integer; + FGC : TGC; + FAtomClose : TAtom; { X Atom for close window button } + FCursorVisible : Boolean; + FX11InvisibleCursor : TCursor; { Blank cursor } + FFullScreen : Boolean; { Keeps a snapshot of the PTC_X11_FULLSCREEN option + taken at the time 'open' was called } + FFocus : Boolean; + FModeSwitcher : TX11Modes; + + FPreviousMouseButtonState : TPTCMouseButtonState; + FPreviousMouseX, FPreviousMouseY : Integer; { for calculating the deltas } + FPreviousMousePositionSaved : Boolean; { true, if FPreviousMouseX, + FPreviousMouseY and FPreviousMouseButtonState contain valid values } + Public + Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Override; + Destructor Destroy; Override; + + Procedure Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); Override; + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat); Override; + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); Override; + Procedure Close; Override; + Procedure Update; Override; + Procedure Update(Const AArea : TPTCArea); Override; + Function Lock : Pointer; Override; + Procedure Unlock; Override; + Procedure GetModes(Var AModes : TPTCModeDynArray); Override; + Procedure Palette(Const APalette : TPTCPalette); Override; + Function GetPitch : Integer; Override; + Function GetX11Window : TWindow; Override; + Function GetX11GC : TGC; Virtual; + Function IsFullScreen : Boolean; Override; + Procedure SetCursor(AVisible : Boolean); Override; + End; diff --git a/packages/ptc/src/x11/x11windowdisplayi.inc b/packages/ptc/src/x11/x11windowdisplayi.inc new file mode 100644 index 0000000000..f6841db41c --- /dev/null +++ b/packages/ptc/src/x11/x11windowdisplayi.inc @@ -0,0 +1,738 @@ +Constructor TX11WindowDisplay.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); + +Begin + Inherited; + FFocus := True; + FX11InvisibleCursor := None; + FCursorVisible := True; +End; + +Destructor TX11WindowDisplay.Destroy; + +Begin + Close; + Inherited Destroy; +End; + +Procedure TX11WindowDisplay.Open(ATitle : AnsiString; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); + +Var + tmpFormat : TPTCFormat; + xgcv : TXGCValues; + textprop : TXTextProperty; + e : TXEvent; + found : Boolean; + attr : TXSetWindowAttributes; + size_hints : PXSizeHints; + tmpArea : TPTCArea; + 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); + +Begin + FHeight := AHeight; + FWidth := AWidth; + FDestX := 0; + FDestY := 0; + + FFullScreen := PTC_X11_FULLSCREEN In FFlags; + + 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 } + tmpFormat := Nil; + Try + tmpFormat := GetX11Format(AFormat); + FFormat.Assign(tmpFormat); + Finally + tmpFormat.Free; + End; + tmpFormat := Nil; + + { Create a window } + FWindow := XCreateSimpleWindow(FDisplay, RootWindow(FDisplay, FScreen), 0, 0, + AWidth, AHeight, 0, BlackPixel(FDisplay, FScreen), + BlackPixel(FDisplay, FScreen)); + { Register the delete atom } + FAtomClose := XInternAtom(FDisplay, 'WM_DELETE_WINDOW', False); + X11Check(XSetWMProtocols(FDisplay, FWindow, @FAtomClose, 1), 'XSetWMProtocols'); + { Get graphics context } + xgcv.graphics_exposures := False; + FGC := XCreateGC(FDisplay, FWindow, GCGraphicsExposures, @xgcv); + If FGC = Nil Then + Raise TPTCError.Create('can''t create graphics context'); + { 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 := PMinSize Or PBaseSize; + size_hints^.min_width := AWidth; + size_hints^.min_height := AHeight; + size_hints^.base_width := AWidth; + size_hints^.base_height := AHeight; + If FFullScreen Then + Begin + size_hints^.flags := size_hints^.flags Or PWinGravity; + size_hints^.win_gravity := StaticGravity; + End + Else + Begin + { not fullscreen - add maxsize limit=minsize, i.e. make window not resizable } + size_hints^.flags := size_hints^.flags Or PMaxSize; + size_hints^.max_width := AWidth; + size_hints^.max_height := AHeight; + 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); + XSync(FDisplay, False); + { Create XImage using factory method } + FPrimary := CreateImage(FDisplay, FScreen, FWidth, FHeight, FFormat); + + 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 } + tmpArea := TPTCArea.Create(0, 0, FWidth, FHeight); + Try + FClip.Assign(tmpArea); + Finally + tmpArea.Free; + End; + + { Installs the right colour map for 8 bit modes } + CreateColormap; + + If FFullScreen Then + EnterFullScreen; +End; + +Procedure TX11WindowDisplay.Open(AWindow : TWindow; Const AFormat : TPTCFormat); + +Begin +End; + +Procedure TX11WindowDisplay.Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); + +Begin +End; + +Procedure TX11WindowDisplay.Close; + +Begin + FreeAndNil(FModeSwitcher); + + {pthreads?!} + If FCMap <> 0 Then + Begin + XFreeColormap(FDisplay, FCMap); + FCMap := 0; + End; + + { Destroy XImage and buffer } + FreeAndNil(FPrimary); + FreeMemAndNil(FColours); + + { 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.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.SetCursor(AVisible : Boolean); + +Begin + FCursorVisible := AVisible; + + If FFocus Then + internal_ShowCursor(FCursorVisible); +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); + End + Else + Begin + { focus out } + If FFullScreen Then + LeaveFullScreen; + + internal_ShowCursor(True); + End; + + XSync(FDisplay, False); +End; + +Procedure TX11WindowDisplay.HandleEvents; + +Var + e : TXEvent; + NewFocus : Boolean; + NewFocusSpecified : Boolean; + + Function UsefulEventsPending : Boolean; + + Var + tmpEvent : TXEvent; + + Begin + If XCheckTypedEvent(FDisplay, ClientMessage, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + If XCheckMaskEvent(FDisplay, FocusChangeMask Or + KeyPressMask Or KeyReleaseMask Or + ButtonPressMask Or ButtonReleaseMask Or + PointerMotionMask Or ExposureMask, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + Result := False; + End; + + Procedure HandleKeyEvent; + + Var + sym : TKeySym; + sym_modded : TKeySym; { modifiers like shift are taken into account here } + press : Boolean; + alt, shift, ctrl : Boolean; + uni : Integer; + key : TPTCKeyEvent; + buf : Array[1..16] Of Char; + + Begin + sym := XLookupKeySym(@e.xkey, 0); + XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil); + uni := X11ConvertKeySymToUnicode(sym_modded); + alt := (e.xkey.state And Mod1Mask) <> 0; + shift := (e.xkey.state And ShiftMask) <> 0; + ctrl := (e.xkey.state And ControlMask) <> 0; + If e._type = KeyPress Then + press := True + Else + press := False; + + key := Nil; + Case sym Shr 8 Of + 0 : key := TPTCKeyEvent.Create(FNormalKeys[sym And $FF], uni, alt, shift, ctrl, press); + $FF : key := TPTCKeyEvent.Create(FFunctionKeys[sym And $FF], uni, alt, shift, ctrl, press); + Else + key := TPTCKeyEvent.Create; + End; + FEventQueue.AddEvent(key); + 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; + +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 + Halt(0); + End; + Expose : Begin + {...} + End; + KeyPress, KeyRelease : HandleKeyEvent; + ButtonPress, ButtonRelease, MotionNotify : HandleMouseEvent; + End; + End; + If NewFocusSpecified Then + HandleChangeFocus(NewFocus); +End; + +Procedure TX11WindowDisplay.Update; + +Begin + FPrimary.Put(FWindow, FGC, FDestX, FDestY); + + HandleEvents; +End; + +Procedure TX11WindowDisplay.Update(Const AArea : TPTCArea); + +Var + updatearea : TPTCArea; + tmparea : TPTCArea; + +Begin + tmparea := TPTCArea.Create(0, 0, FWidth, FHeight); + Try + updatearea := TPTCClipper.Clip(tmparea, AArea); + Try + FPrimary.Put(FWindow, FGC, updatearea.Left, updatearea.Top, + FDestX + updatearea.Left, FDestY + updatearea.Top, + updatearea.Width, updatearea.Height); + Finally + updatearea.Free; + End; + Finally + tmparea.Free; + End; + + HandleEvents; +End; + +Function TX11WindowDisplay.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; + +Var + tmpEvent : TXEvent; + +Begin + FreeAndNil(AEvent); + 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) : TPTCEvent; + +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 : TPTCModeDynArray); + +Var + current_desktop_format, tmpfmt : TPTCFormat; + +Begin + If FModeSwitcher = Nil Then + FModeSwitcher := CreateModeSwitcher; + + current_desktop_format := Nil; + tmpfmt := TPTCFormat.Create(8); + Try + current_desktop_format := GetX11Format(tmpfmt); + + FModeSwitcher.GetModes(AModes, current_desktop_format); + Finally + tmpfmt.Free; + current_desktop_format.Free; + End; +End; + +Procedure TX11WindowDisplay.Palette(Const APalette : TPTCPalette); + +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 : TPTCFormat) : 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; + +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; diff --git a/packages/ptc/src/x11/xunikey.inc b/packages/ptc/src/x11/xunikey.inc new file mode 100644 index 0000000000..62f4d52d60 --- /dev/null +++ b/packages/ptc/src/x11/xunikey.inc @@ -0,0 +1,216 @@ + +Function X11ConvertKeySymToUnicode(sym : TKeySym) : Integer; + +Begin + If (sym >= $20) And (sym <= $7E) Then + Exit(sym); +{ Case sym Of + XK_BackSpace : Exit(8); + XK_Tab : Exit(9); + XK_Return : Exit(13); + XK_Escape : Exit(27); + End;} + Case sym Of + XKc_Cyrillic_GHE_bar : Exit($492); + XK_Cyrillic_ghe_bar : Exit($493); + XKc_Cyrillic_ZHE_descender : Exit($496); + XK_Cyrillic_zhe_descender : Exit($497); + XKc_Cyrillic_KA_descender : Exit($49A); + XK_Cyrillic_ka_descender : Exit($49B); + XKc_Cyrillic_KA_vertstroke : Exit($49C); + XK_Cyrillic_ka_vertstroke : Exit($49D); + XKc_Cyrillic_EN_descender : Exit($4A2); + XK_Cyrillic_en_descender : Exit($4A3); + XKc_Cyrillic_U_straight : Exit($4AE); + XK_Cyrillic_u_straight : Exit($4AF); + XKc_Cyrillic_U_straight_bar : Exit($4B0); + XK_Cyrillic_u_straight_bar : Exit($4B1); + XKc_Cyrillic_HA_descender : Exit($4B2); + XK_Cyrillic_ha_descender : Exit($4B3); + XKc_Cyrillic_CHE_descender : Exit($4B6); + XK_Cyrillic_che_descender : Exit($4B7); + XKc_Cyrillic_CHE_vertstroke : Exit($4B8); + XK_Cyrillic_che_vertstroke : Exit($4B9); + XKc_Cyrillic_SHHA : Exit($4BA); + XK_Cyrillic_shha : Exit($4BB); + + XKc_Cyrillic_SCHWA : Exit($4D8); + XK_Cyrillic_schwa : Exit($4D9); + XKc_Cyrillic_I_macron : Exit($4E2); + XK_Cyrillic_i_macron : Exit($4E3); + XKc_Cyrillic_O_bar : Exit($4E8); + XK_Cyrillic_o_bar : Exit($4E9); + XKc_Cyrillic_U_macron : Exit($4EE); + XK_Cyrillic_u_macron : Exit($4EF); + + XK_Serbian_dje : Exit($452); + XK_Macedonia_gje : Exit($453); + XK_Cyrillic_io : Exit($451); + XK_Ukrainian_ie : Exit($454); + XK_Macedonia_dse : Exit($455); + XK_Ukrainian_i : Exit($456); + XK_Ukrainian_yi : Exit($457); + XK_Cyrillic_je : Exit($458); + XK_Cyrillic_lje : Exit($459); + XK_Cyrillic_nje : Exit($45A); + XK_Serbian_tshe : Exit($45B); + XK_Macedonia_kje : Exit($45C); + XK_Ukrainian_ghe_with_upturn : Exit($491); + XK_Byelorussian_shortu : Exit($45E); + XK_Cyrillic_dzhe : Exit($45F); + XK_numerosign : Exit($2116); + XKc_Serbian_DJE : Exit($402); + XKc_Macedonia_GJE : Exit($403); + XKc_Cyrillic_IO : Exit($401); + XKc_Ukrainian_IE : Exit($404); + XKc_Macedonia_DSE : Exit($405); + XKc_Ukrainian_I : Exit($406); + XKc_Ukrainian_YI : Exit($407); + XKc_Cyrillic_JE : Exit($408); + XKc_Cyrillic_LJE : Exit($409); + XKc_Cyrillic_NJE : Exit($40A); + XKc_Serbian_TSHE : Exit($40B); + XKc_Macedonia_KJE : Exit($40C); + XKc_Ukrainian_GHE_WITH_UPTURN : Exit($490); + XKc_Byelorussian_SHORTU : Exit($40E); + XKc_Cyrillic_DZHE : Exit($40F); + XK_Cyrillic_yu : Exit($44E); + XK_Cyrillic_a : Exit($430); + XK_Cyrillic_be : Exit($431); + XK_Cyrillic_tse : Exit($446); + XK_Cyrillic_de : Exit($434); + XK_Cyrillic_ie : Exit($435); + XK_Cyrillic_ef : Exit($444); + XK_Cyrillic_ghe : Exit($433); + XK_Cyrillic_ha : Exit($445); + XK_Cyrillic_i : Exit($438); + XK_Cyrillic_shorti : Exit($439); + XK_Cyrillic_ka : Exit($43A); + XK_Cyrillic_el : Exit($43B); + XK_Cyrillic_em : Exit($43C); + XK_Cyrillic_en : Exit($43D); + XK_Cyrillic_o : Exit($43E); + XK_Cyrillic_pe : Exit($43F); + XK_Cyrillic_ya : Exit($44F); + XK_Cyrillic_er : Exit($440); + XK_Cyrillic_es : Exit($441); + XK_Cyrillic_te : Exit($442); + XK_Cyrillic_u : Exit($443); + XK_Cyrillic_zhe : Exit($436); + XK_Cyrillic_ve : Exit($432); + XK_Cyrillic_softsign : Exit($44C); + XK_Cyrillic_yeru : Exit($44B); + XK_Cyrillic_ze : Exit($437); + XK_Cyrillic_sha : Exit($448); + XK_Cyrillic_e : Exit($44D); + XK_Cyrillic_shcha : Exit($449); + XK_Cyrillic_che : Exit($447); + XK_Cyrillic_hardsign : Exit($44A); + XKc_Cyrillic_YU : Exit($42E); + XKc_Cyrillic_A : Exit($410); + XKc_Cyrillic_BE : Exit($411); + XKc_Cyrillic_TSE : Exit($426); + XKc_Cyrillic_DE : Exit($414); + XKc_Cyrillic_IE : Exit($415); + XKc_Cyrillic_EF : Exit($424); + XKc_Cyrillic_GHE : Exit($413); + XKc_Cyrillic_HA : Exit($425); + XKc_Cyrillic_I : Exit($418); + XKc_Cyrillic_SHORTI : Exit($419); + XKc_Cyrillic_KA : Exit($41A); + XKc_Cyrillic_EL : Exit($41B); + XKc_Cyrillic_EM : Exit($41C); + XKc_Cyrillic_EN : Exit($41D); + XKc_Cyrillic_O : Exit($41E); + XKc_Cyrillic_PE : Exit($41F); + XKc_Cyrillic_YA : Exit($42F); + XKc_Cyrillic_ER : Exit($420); + XKc_Cyrillic_ES : Exit($421); + XKc_Cyrillic_TE : Exit($422); + XKc_Cyrillic_U : Exit($423); + XKc_Cyrillic_ZHE : Exit($416); + XKc_Cyrillic_VE : Exit($412); + XKc_Cyrillic_SOFTSIGN : Exit($42C); + XKc_Cyrillic_YERU : Exit($42B); + XKc_Cyrillic_ZE : Exit($417); + XKc_Cyrillic_SHA : Exit($428); + XKc_Cyrillic_E : Exit($42D); + XKc_Cyrillic_SHCHA : Exit($429); + XKc_Cyrillic_CHE : Exit($427); + XKc_Cyrillic_HARDSIGN : Exit($42A); + +{ XKc_Greek_ALPHAaccent : Exit($); + XKc_Greek_EPSILONaccent : Exit($); + XKc_Greek_ETAaccent : Exit($); + XKc_Greek_IOTAaccent : Exit($); + XKc_Greek_IOTAdieresis : Exit($); + XKc_Greek_OMICRONaccent : Exit($); + XKc_Greek_UPSILONaccent : Exit($); + XKc_Greek_UPSILONdieresis : Exit($); + XKc_Greek_OMEGAaccent : Exit($); + XK_Greek_accentdieresis : Exit($); + XK_Greek_horizbar : Exit($); + XK_Greek_alphaaccent : Exit($); + XK_Greek_epsilonaccent : Exit($); + XK_Greek_etaaccent : Exit($); + XK_Greek_iotaaccent : Exit($); + XK_Greek_iotadieresis : Exit($); + XK_Greek_iotaaccentdieresis : Exit($); + XK_Greek_omicronaccent : Exit($); + XK_Greek_upsilonaccent : Exit($); + XK_Greek_upsilondieresis : Exit($); + XK_Greek_upsilonaccentdieresis : Exit($); + XK_Greek_omegaaccent : Exit($);} + XKc_Greek_ALPHA : Exit($391); + XKc_Greek_BETA : Exit($392); + XKc_Greek_GAMMA : Exit($393); + XKc_Greek_DELTA : Exit($394); + XKc_Greek_EPSILON : Exit($395); + XKc_Greek_ZETA : Exit($396); + XKc_Greek_ETA : Exit($397); + XKc_Greek_THETA : Exit($398); + XKc_Greek_IOTA : Exit($399); + XKc_Greek_KAPPA : Exit($39A); + XKc_Greek_LAMDA : Exit($39B); + XKc_Greek_MU : Exit($39C); + XKc_Greek_NU : Exit($39D); + XKc_Greek_XI : Exit($39E); + XKc_Greek_OMICRON : Exit($39F); + XKc_Greek_PI : Exit($3A0); + XKc_Greek_RHO : Exit($3A1); + XKc_Greek_SIGMA : Exit($3A3); + XKc_Greek_TAU : Exit($3A4); + XKc_Greek_UPSILON : Exit($3A5); + XKc_Greek_PHI : Exit($3A6); + XKc_Greek_CHI : Exit($3A7); + XKc_Greek_PSI : Exit($3A8); + XKc_Greek_OMEGA : Exit($3A9); + XK_Greek_alpha : Exit($3B1); + XK_Greek_beta : Exit($3B2); + XK_Greek_gamma : Exit($3B3); + XK_Greek_delta : Exit($3B4); + XK_Greek_epsilon : Exit($3B5); + XK_Greek_zeta : Exit($3B6); + XK_Greek_eta : Exit($3B7); + XK_Greek_theta : Exit($3B8); + XK_Greek_iota : Exit($3B9); + XK_Greek_kappa : Exit($3BA); + XK_Greek_lamda : Exit($3BB); + XK_Greek_mu : Exit($3BC); + XK_Greek_nu : Exit($3BD); + XK_Greek_xi : Exit($3BE); + XK_Greek_omicron : Exit($3BF); + XK_Greek_pi : Exit($3C0); + XK_Greek_rho : Exit($3C1); + XK_Greek_sigma : Exit($3C2); + XK_Greek_finalsmallsigma : Exit($3C3); + XK_Greek_tau : Exit($3C4); + XK_Greek_upsilon : Exit($3C5); + XK_Greek_phi : Exit($3C6); + XK_Greek_chi : Exit($3C7); + XK_Greek_psi : Exit($3C8); + XK_Greek_omega : Exit($3C9); + + End; + X11ConvertKeySymToUnicode := -1; +End; |