+ UPgrade PTCpas to 0.99.7

git-svn-id: trunk@6909 -

.gitattributes

@@ -3308,17 +3308,17 @@ packages/extra/ptc/win32/directx/libraryd.inc -text
 packages/extra/ptc/win32/directx/primary.inc -text
 packages/extra/ptc/win32/directx/primaryd.inc -text
 packages/extra/ptc/win32/directx/translte.inc -text
-packages/extra/ptc/x11/check.inc -text
-packages/extra/ptc/x11/console.inc -text
-packages/extra/ptc/x11/consoled.inc -text
-packages/extra/ptc/x11/dgadisp.inc -text
-packages/extra/ptc/x11/dgadispd.inc -text
-packages/extra/ptc/x11/display.inc -text
-packages/extra/ptc/x11/displayd.inc -text
-packages/extra/ptc/x11/image.inc -text
-packages/extra/ptc/x11/imaged.inc -text
-packages/extra/ptc/x11/window.inc -text
+packages/extra/ptc/x11/check.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/consoled.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/consolei.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/dgadispd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/dgadispi.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/displayd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/displayi.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/imaged.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/imagei.inc svneol=native#text/x-pascal
 packages/extra/ptc/x11/windowd.inc -text
+packages/extra/ptc/x11/windowi.inc svneol=native#text/x-pascal
 packages/extra/ptc/x11/xunikey.inc -text
 packages/extra/rexx/Makefile svneol=native#text/plain
 packages/extra/rexx/Makefile.fpc svneol=native#text/plain

packages/extra/ptc/basecond.inc

@@ -20,41 +20,38 @@
 
 Type
   TPTCBaseConsole=Class(TPTCBaseSurface)
-  Protected
+  Private
     FReleaseEnabled : Boolean;
-    
-    Procedure internal_ReadKey(k : TPTCKey); Virtual; Abstract;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Virtual; Abstract;
   Public
     Constructor Create;
     Procedure configure(Const _file : String); Virtual; Abstract;
     Function modes : PPTCMode; Virtual; Abstract;
-    Procedure open(Const _title : String; _pages : Integer); Overload; Virtual; Abstract;
+    Procedure open(Const _title : String; _pages : Integer = 0); Overload; Virtual; Abstract;
     Procedure open(Const _title : String; Const _format : TPTCFormat;
-                   _pages : Integer); Overload; Virtual; Abstract;
+                   _pages : Integer = 0); Overload; Virtual; Abstract;
     Procedure open(Const _title : String; _width, _height : Integer;
-                   Const _format : TPTCFormat; _pages : Integer); Overload; Virtual; Abstract;
+                   Const _format : TPTCFormat; _pages : Integer = 0); Overload; Virtual; Abstract;
     Procedure open(Const _title : String; Const _mode : TPTCMode;
-                   _pages : Integer); Overload; Virtual; Abstract;
-    {pages=0}
-    Procedure open(Const _title : String); Overload; Virtual;
-    Procedure open(Const _title : String; Const _format : TPTCFormat); Overload; Virtual;
-    Procedure open(Const _title : String; _width, _height : Integer;
-                   Const _format : TPTCFormat); Overload; Virtual;
-    Procedure open(Const _title : String; Const _mode : TPTCMode); Overload; Virtual;
-    {/pages=0}
+                   _pages : Integer = 0); Overload; Virtual; Abstract;
     Procedure close; Virtual; Abstract;
     Procedure flush; Virtual; Abstract;
     Procedure finish; Virtual; Abstract;
     Procedure update; Virtual; Abstract;
     Procedure update(Const _area : TPTCArea); Virtual; Abstract;
+    
+    { event handling }
+    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Virtual; Abstract;
+    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Virtual; Abstract;
+    
+    { key handling }
     Function KeyPressed : Boolean;
-    Function PeekKey(k : TPTCKey) : Boolean;
-    Procedure ReadKey(k : TPTCKey);
+    Function PeekKey(Var k : TPTCKeyEvent) : Boolean;
+    Procedure ReadKey(Var k : TPTCKeyEvent);
     Procedure ReadKey;
+    Property KeyReleaseEnabled : Boolean Read FReleaseEnabled Write FReleaseEnabled;
+    
     Function pages : Integer; Virtual; Abstract;
     Function name : String; Virtual; Abstract;
     Function title : String; Virtual; Abstract;
     Function information : String; Virtual; Abstract;
-    Property KeyReleaseEnabled : Boolean Read FReleaseEnabled Write FReleaseEnabled;
   End;

packages/extra/ptc/baseconi.inc

@@ -24,60 +24,44 @@ Begin
   FReleaseEnabled := False;
 End;
 
-Procedure TPTCBaseConsole.open(Const _title : String);{ Overload;}
-
-Begin
-  open(_title, 0);
-End;
-
-Procedure TPTCBaseConsole.open(Const _title : String; Const _format : TPTCFormat);{ Overload;}
-
-Begin
-  open(_title, _format, 0);
-End;
-
-Procedure TPTCBaseConsole.open(Const _title : String; _width, _height : Integer;
-                               Const _format : TPTCFormat);{ Overload;}
-
-Begin
-  open(_title, _width, _height, _format, 0);
-End;
-
-Procedure TPTCBaseConsole.open(Const _title : String; Const _mode : TPTCMode);{ Overload;}
-
-Begin
-  open(_title, _mode, 0);
-End;
-
 Function TPTCBaseConsole.KeyPressed : Boolean;
 
 Var
-  k : TPTCKey;
+  k, kpeek : TPTCEvent;
 
 Begin
-  k := TPTCKey.Create;
+  k := Nil;
   Try
     Repeat
-      If internal_PeekKey(k) = False Then
+      kpeek := PeekEvent(False, [PTCKeyEvent]);
+      If kpeek = Nil Then
         Exit(False);
-      If FReleaseEnabled Or k.Press Then
+      If FReleaseEnabled Or (kpeek As TPTCKeyEvent).Press Then
         Exit(True);
-      internal_ReadKey(k);
+      NextEvent(k, False, [PTCKeyEvent]);
     Until False;
   Finally
     k.Free;
   End;
 End;
 
-Procedure TPTCBaseConsole.ReadKey(k : TPTCKey);
+Procedure TPTCBaseConsole.ReadKey(Var k : TPTCKeyEvent);
+
+Var
+  ev : TPTCEvent;
 
 Begin
-  Repeat
-    internal_ReadKey(k);
-  Until FReleaseEnabled Or k.Press;
+  ev := k;
+  Try
+    Repeat
+      NextEvent(ev, True, [PTCKeyEvent]);
+    Until FReleaseEnabled Or (ev As TPTCKeyEvent).Press;
+  Finally
+    k := ev As TPTCKeyEvent;
+  End;
 End;
 
-Function TPTCBaseConsole.PeekKey(k : TPTCKey) : Boolean;
+Function TPTCBaseConsole.PeekKey(Var k : TPTCKeyEvent) : Boolean;
 
 Begin
   If KeyPressed Then
@@ -92,10 +76,10 @@ End;
 Procedure TPTCBaseConsole.ReadKey;
 
 Var
-  k : TPTCKey;
+  k : TPTCKeyEvent;
 
 Begin
-  k := TPTCKey.Create;
+  k := TPTCKeyEvent.Create;
   Try
     ReadKey(k);
   Finally

packages/extra/ptc/consoled.inc

@@ -27,31 +27,19 @@ Type
     console : TPTCBaseConsole;
     m_modes : Array[0..1023] Of TPTCMode;
     hacky_option_console_flag : Boolean;
-  Protected
-    Procedure internal_ReadKey(k : TPTCKey); Override;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Override;
   Public
     Constructor Create;
     Destructor Destroy; Override;
     Procedure configure(Const _file : String); Override;
     Function option(Const _option : String) : Boolean; Override;
     Function modes : PPTCMode; Override;
-    Procedure open(Const _title : String; _pages : Integer); Overload; Override;
+    Procedure open(Const _title : String; _pages : Integer = 0); Overload; Override;
     Procedure open(Const _title : String; Const _format : TPTCFormat;
-                   _pages : Integer); Overload; Override;
+                   _pages : Integer = 0); Overload; Override;
     Procedure open(Const _title : String; _width, _height : Integer;
-                   Const _format : TPTCFormat; _pages : Integer); Overload; Override;
+                   Const _format : TPTCFormat; _pages : Integer = 0); Overload; Override;
     Procedure open(Const _title : String; Const _mode : TPTCMode;
-                   _pages : Integer); Overload; Override;
-
-    {$WARNING this should be removed for fpc 1.1}
-    {pages=0}
-    Procedure open(Const _title : String); Overload; Override;
-    Procedure open(Const _title : String; Const _format : TPTCFormat); Overload; Override;
-    Procedure open(Const _title : String; _width, _height : Integer;
-                   Const _format : TPTCFormat); Overload; Override;
-    Procedure open(Const _title : String; Const _mode : TPTCMode); Overload; Override;
-    {/pages=0}
+                   _pages : Integer = 0); Overload; Override;
 
     Procedure close; Override;
     Procedure flush; Override;
@@ -98,4 +86,6 @@ Type
     Function name : String; Override;
     Function title : String; Override;
     Function information : String; Override;
+    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override;
   End;

packages/extra/ptc/consolei.inc

@@ -34,16 +34,16 @@ Begin
   For I := Low(m_modes) To High(m_modes) Do
     m_modes[I] := TPTCMode.Create;
   {$IFDEF UNIX}
-  configure('/usr/share/ptc/ptc.conf');
+  configure('/usr/share/ptcpas/ptcpas.conf');
   s := fpgetenv('HOME');
   If s = '' Then
     s := '/';
   If s[Length(s)] <> '/' Then
     s := s + '/';
-  s := s + '.ptc.conf';
+  s := s + '.ptcpas.conf';
   configure(s);
   {$ELSE UNIX}
-  configure('ptc.cfg');
+  configure('ptcpas.cfg');
   {$ENDIF UNIX}
 End;
 
@@ -447,20 +447,6 @@ Begin
   console.update(_area);
 End;
 
-Procedure TPTCConsole.internal_ReadKey(k : TPTCKey);
-
-Begin
-  check;
-  console.internal_ReadKey(k);
-End;
-
-Function TPTCConsole.internal_PeekKey(k : TPTCKey) : Boolean;
-
-Begin
-  check;
-  Result := console.internal_PeekKey(k);
-End;
-
 Procedure TPTCConsole.copy(Var surface : TPTCBaseSurface);
 
 Begin
@@ -658,6 +644,20 @@ Begin
   information := console.information;
 End;
 
+Function TPTCConsole.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean;
+
+Begin
+  check;
+  Result := console.NextEvent(event, wait, EventMask);
+End;
+
+Function TPTCConsole.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent;
+
+Begin
+  check;
+  Result := console.PeekEvent(wait, EventMask);
+End;
+
 Function TPTCConsole.ConsoleCreate(index : Integer) : TPTCBaseConsole;
 
 Begin
@@ -718,36 +718,8 @@ End;
 Procedure TPTCConsole.check;
 
 Begin
-  {$IFDEF DEBUG}
+  { $IFDEF DEBUG}
   If console = Nil Then
     Raise TPTCError.Create('console is not open (core)');
-  {$ENDIF DEBUG}
-End;
-
-{$WARNING this should be removed for fpc 1.1}
-{pages=0}
-Procedure TPTCConsole.open(Const _title : String);
-
-Begin
-  open(_title, 0);
-End;
-
-Procedure TPTCConsole.open(Const _title : String; Const _format : TPTCFormat);
-
-Begin
-  open(_title, _format, 0);
-End;
-
-Procedure TPTCConsole.open(Const _title : String; _width, _height : Integer;
-                           Const _format : TPTCFormat);
-
-Begin
-  open(_title, _width, _height, _format, 0);
-End;
-
-Procedure TPTCConsole.open(Const _title : String; Const _mode : TPTCMode);
-
-Begin
-  open(_title, _mode, 0);
+  { $ENDIF DEBUG}
 End;
-{/pages=0}

packages/extra/ptc/demos/fire.pp

@@ -15,7 +15,7 @@ Program Fire;
 Uses
   ptc;
 
-Function pack(r, g, b : int32) : int32;
+Function pack(r, g, b : Uint32) : Uint32;
 
 Begin
   { pack color integer }
@@ -25,50 +25,53 @@ End;
 Procedure generate(palette : TPTCPalette);
 
 Var
-  data : Pint32;
+  data : PUint32;
   i, c : Integer;
 
 Begin
   { lock palette data }
   data := palette.lock;
 
-  { black to red }
-  i := 0;
-  c := 0;
-  While i < 64 Do
-  Begin
-    data[i] := pack(c, 0, 0);
-    Inc(c, 4);
-    Inc(i);
-  End;
+  Try
+    { black to red }
+    i := 0;
+    c := 0;
+    While i < 64 Do
+    Begin
+      data[i] := pack(c, 0, 0);
+      Inc(c, 4);
+      Inc(i);
+    End;
 
-  { red to yellow }
-  c := 0;
-  While i < 128 Do
-  Begin
-    data[i] := pack(255, c, 0);
-    Inc(c, 4);
-    Inc(i);
-  End;
+    { red to yellow }
+    c := 0;
+    While i < 128 Do
+    Begin
+      data[i] := pack(255, c, 0);
+      Inc(c, 4);
+      Inc(i);
+    End;
 
-  { yellow to white }
-  c := 0;
-  While i < {192}128 Do
-  Begin
-    data[i] := pack(255, 255, c);
-    Inc(c, 4);
-    Inc(i);
-  End;
+    { yellow to white }
+    c := 0;
+    While i < {192}128 Do
+    Begin
+      data[i] := pack(255, 255, c);
+      Inc(c, 4);
+      Inc(i);
+    End;
 
-  { white }
-  While i < 256 Do
-  Begin
-    data[i] := pack(255, 255, 255);
-    Inc(i);
-  End;
+    { white }
+    While i < 256 Do
+    Begin
+      data[i] := pack(255, 255, 255);
+      Inc(i);
+    End;
 
-  { unlock palette }
-  palette.unlock;
+  Finally
+    { unlock palette }
+    palette.unlock;
+  End;
 End;
 
 Var
@@ -78,11 +81,11 @@ Var
   palette : TPTCPalette;
   state : Integer;
   intensity : Single;
-  pixels, pixel, p : Pchar8;
+  pixels, pixel, p : PUint8;
   width, height : Integer;
   x, y : Integer;
-  top, bottom, c1, c2 : int32;
-  generator : Pchar8;
+  top, bottom, c1, c2 : Uint32;
+  generator : PUint8;
   color : Integer;
   area : TPTCArea;
 

packages/extra/ptc/demos/flower.pp

@@ -15,7 +15,7 @@ Program Flower;
 Uses
   ptc, Math;
 
-Function pack(r, g, b : int32) : int32;
+Function pack(r, g, b : Uint32) : Uint32;
 
 Begin
   { pack color integer }
@@ -25,7 +25,7 @@ End;
 Procedure generate_flower(flower : TPTCSurface);
 
 Var
-  data : Pchar8;
+  data : PUint8;
   x, y, fx, fy, fx2, fy2 : Integer;
   TWO_PI : Single;
 
@@ -62,7 +62,7 @@ End;
 Procedure generate(palette : TPTCPalette);
 
 Var
-  data : Pint32;
+  data : PUint32;
   i, c : Integer;
 
 Begin
@@ -120,7 +120,7 @@ Var
   palette : TPTCPalette;
   area : TPTCArea;
   time, delta : Single;
-  scr, map : Pchar8;
+  scr, map : PUint8;
   width, height, mapWidth : Integer;
   xo, yo, xo2, yo2, xo3, yo3 : Single;
   offset1, offset2, offset3 : Integer;

packages/extra/ptc/demos/land.pp

@@ -27,8 +27,8 @@ Const
   FOV : Integer = 256; { half of the xy field of view (This is based on the 0-2048 convention) }
 
 Var
-  HMap : Array[0..256*256 - 1] Of char8; { Height field }
-  CMap : Array[0..256*256 - 1] Of char8; { Color map }
+  HMap : Array[0..256*256 - 1] Of Uint8; { Height field }
+  CMap : Array[0..256*256 - 1] Of Uint8; { Color map }
 
   lasty, { Last pixel drawn on a given column }
   lastc : Array[0..SCREENWIDTH - 1] Of Integer; { Color of last pixel on a column }
@@ -144,12 +144,12 @@ End;
  for the distance. x0,y0,x1,y1 are 16.16 fixed point numbers and the
  scaling factor is a 16.8 fixed point value.
 }
-Procedure Line(x0, y0, x1, y1, hy, s : Integer; surface_buffer : Pint32; fadeout : Integer);
+Procedure Line(x0, y0, x1, y1, hy, s : Integer; surface_buffer : PUint32; fadeout : Integer);
 
 Var
   sx, sy, i, a, b, u0, u1, v0, v1, h0, h1, h2, h3, h, c, y : Integer;
   coord_x, coord_y, sc, cc, currentColor : Integer;
-  pixel : Pint32;
+  pixel : PUint32;
 
 Begin
   { Compute xy speed }
@@ -232,7 +232,7 @@ Begin
 End;
 
 { Draw the view from the point x0,y0 (16.16) looking at angle a }
-Procedure View(x0, y0, angle, height : Integer; surface_buffer : Pint32);
+Procedure View(x0, y0, angle, height : Integer; surface_buffer : PUint32);
 
 Var
   d, u0, a, v0, u1, v1, h0, h1, h2, h3 : Integer;
@@ -283,8 +283,8 @@ Var
   console : TPTCConsole;
   surface : TPTCSurface;
   timer : TPTCTimer;
-  key : TPTCKey;
-  pixels : Pint32;
+  key : TPTCKeyEvent;
+  pixels : PUint32;
   Done : Boolean;
 
   x0, y0 : Integer;
@@ -301,7 +301,7 @@ Begin
   key := Nil;
   Try
     Try
-      key := TPTCKey.Create;
+      key := TPTCKeyEvent.Create;
       format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
       console := TPTCConsole.Create;
       console.open('Land demo', SCREENWIDTH, SCREENHEIGHT, format);

packages/extra/ptc/demos/lights.pp

@@ -34,8 +34,8 @@ Var
   palette : TPTCPalette;
   dx, dy : Integer;
   divisor : Single;
-  data : Pint32;
-  pixels, line : Pchar8;
+  data : PUint32;
+  pixels, line : PUint8;
   width : Integer;
   i : Integer;
   x, y, x1, y1, x2, y2, x3, y3, x4, y4 : Integer;

packages/extra/ptc/demos/mojo.pp

@@ -34,11 +34,11 @@ Const
   SC = 12;
   MINSEGSIZE = 2.5;
   NSEG = 5;
-  frandtab_seed : short16 = 54;
+  frandtab_seed : Uint16 = 54;
 
 Var
-  MaskMap : Pchar8;
-  frandtab : Array[0..65535] Of short16;
+  MaskMap : PUint8;
+  frandtab : Array[0..65535] Of Uint16;
 
 Type
   FVector = Object
@@ -596,15 +596,15 @@ Var
   camposn : FVector;
   camaxis : FMatrix;
   c1, c2, c3, ti, xx, yy, zz, i, a, x, y : Integer;
-  idx : Array[0..(200 Div 16) - 1, 0..(320 Div 16) - 1] Of char8;
+  idx : Array[0..(200 Div 16) - 1, 0..(320 Div 16) - 1] Of Uint8;
   order : Array[0..10*19 - 1, 0..1] Of Integer;
   vlightt, t, cz, camf : Single;
   col : FVector;
   ray : TRay;
-  oc, c, c2_ : int32;
+  oc, c, c2_ : Uint32;
   time, delta : Single;
   pitch : Integer;
-  screenbuf, pd : Pchar8;
+  screenbuf, pd : PUint8;
   tmp : FVector;
   F : File;
 
@@ -721,21 +721,21 @@ Begin
 	  oc := c;
 
 	  c2_ := (c Shr 1) And $7F7F7F;
-	  Pint32(pd)[1] := ((Pint32(pd)[1]) Shr 1) And $7F7F7F+ c2_;
-	  Pint32(pd)[2] := ((Pint32(pd)[2]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[1] := ((PUint32(pd)[1]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[2] := ((PUint32(pd)[2]) Shr 1) And $7F7F7F+ c2_;
 	  Inc(pd, pitch);
-	  Pint32(pd)[0] := ((Pint32(pd)[0]) Shr 1) And $7F7F7F+ c2_;
-	  Pint32(pd)[1] := c;
-	  Pint32(pd)[2] := c;
-	  Pint32(pd)[3] := ((Pint32(pd)[3]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[0] := ((PUint32(pd)[0]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[1] := c;
+	  PUint32(pd)[2] := c;
+	  PUint32(pd)[3] := ((PUint32(pd)[3]) Shr 1) And $7F7F7F+ c2_;
 	  Inc(pd, pitch);
-	  Pint32(pd)[0] := ((Pint32(pd)[0]) Shr 1) And $7F7F7F+ c2_;
-	  Pint32(pd)[1] := c;
-	  Pint32(pd)[2] := c;
-	  Pint32(pd)[3] := ((Pint32(pd)[3]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[0] := ((PUint32(pd)[0]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[1] := c;
+	  PUint32(pd)[2] := c;
+	  PUint32(pd)[3] := ((PUint32(pd)[3]) Shr 1) And $7F7F7F+ c2_;
 	  Inc(pd, pitch);
-	  Pint32(pd)[1] := ((Pint32(pd)[1]) Shr 1) And $7F7F7F+ c2_;
-	  Pint32(pd)[2] := ((Pint32(pd)[2]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[1] := ((PUint32(pd)[1]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[2] := ((PUint32(pd)[2]) Shr 1) And $7F7F7F+ c2_;
         End;
         i *= 5;
         i := i Div (3*idx[yy, xx]);

packages/extra/ptc/demos/texwarp.pp

@@ -18,67 +18,75 @@ Uses
 Const
 { colour balance values.  change these if you don't like the colouring }
 { of the texture. }
-  red_balance : int32 = 2;
-  green_balance : int32 = 3;
-  blue_balance : int32 = 1;
+  red_balance : Uint32 = 2;
+  green_balance : Uint32 = 3;
+  blue_balance : Uint32 = 1;
 
 Procedure blur(s : TPTCSurface);
 
 Var
-  d : Pchar8;
+  d : PUint8;
   pitch : Integer;
   spack, r : Integer;
 
 Begin
   { lock surface }
   d := s.lock;
-  pitch := s.pitch;
-  spack := (s.height - 1) * pitch;
+  
+  Try
+    pitch := s.pitch;
+    spack := (s.height - 1) * pitch;
+
+    { first pixel }
+    For r := 0 To 3 Do
+      d[r] := (d[pitch + r] + d[r + 4] + d[spack + r] + d[pitch - 4 + r]) Div 4;
 
-  { first pixel }
-  For r := 0 To 3 Do
-    d[r] := (d[pitch + r] + d[r + 4] + d[spack + r] + d[pitch - 4 + r]) Div 4;
+    { rest of first line }
+    For r := 4 To pitch - 1 Do
+      d[r] := (d[r + pitch] + d[r + 4] + d[r - 4] + d[spack + r]) Div 4;
 
-  { rest of first line }
-  For r := 4 To pitch - 1 Do
-    d[r] := (d[r + pitch] + d[r + 4] + d[r - 4] + d[spack + r]) Div 4;
+    { rest of surface except last line }
+    For r := pitch To ((s.height - 1) * pitch) - 1 Do
+      d[r] := (d[r - pitch] + d[r + pitch] + d[r + 4] + d[r - 4]) Div 4;
 
-  { rest of surface except last line }
-  For r := pitch To ((s.height - 1) * pitch) - 1 Do
-    d[r] := (d[r - pitch] + d[r + pitch] + d[r + 4] + d[r - 4]) Div 4;
+    { last line except last pixel }
+    For r := (s.height - 1) * pitch To (s.height * s.pitch) - 5 Do
+      d[r] := (d[r - pitch] + d[r + 4] + d[r - 4] + d[r - spack]) Div 4;
 
-  { last line except last pixel }
-  For r := (s.height - 1) * pitch To (s.height * s.pitch) - 5 Do
-    d[r] := (d[r - pitch] + d[r + 4] + d[r - 4] + d[r - spack]) Div 4;
+    { last pixel }
+    For r := (s.height * s.pitch) - 4 To s.height * s.pitch Do
+      d[r] := (d[r - pitch] + d[r - 4] + d[r - spack] + d[r + 4 - pitch]) Div 4;
 
-  { last pixel }
-  For r := (s.height * s.pitch) - 4 To s.height * s.pitch Do
-    d[r] := (d[r - pitch] + d[r - 4] + d[r - spack] + d[r + 4 - pitch]) Div 4;
-  s.unlock;
+  Finally
+    s.unlock;
+  End;
 End;
 
 Procedure generate(surface : TPTCSurface);
 
 Var
-  dest : Pint32;
+  dest : PUint32;
   i : Integer;
   x, y : Integer;
-  d : Pint32;
-  cv : int32;
-  r, g, b : char8;
+  d : PUint32;
+  cv : Uint32;
+  r, g, b : Uint8;
 
 Begin
   { draw random dots all over the surface }
   dest := surface.lock;
-  For i := 0 To surface.width * surface.height - 1 Do
-  Begin
-    x := Random(surface.width);
-    y := Random(surface.height);
-    d := dest + (y * surface.width) + x;
-    cv := (Random(100) Shl 16) Or (Random(100) Shl 8) Or Random(100);
-    d^ := cv;
+  Try
+    For i := 0 To surface.width * surface.height - 1 Do
+    Begin
+      x := Random(surface.width);
+      y := Random(surface.height);
+      d := dest + (y * surface.width) + x;
+      cv := (Random(100) Shl 16) Or (Random(100) Shl 8) Or Random(100);
+      d^ := cv;
+    End;
+  Finally
+    surface.unlock;
   End;
-  surface.unlock;
   
   { blur the surface }
   For i := 1 To 5 Do
@@ -86,28 +94,31 @@ Begin
   
   { multiply the color values }
   dest := surface.lock;
-  For i := 0 To surface.width * surface.height - 1 Do
-  Begin
-    cv := dest^;
-    r := (cv Shr 16) And 255;
-    g := (cv Shr 8) And 255;
-    b := cv And 255;
-    r *= red_balance;
-    g *= green_balance;
-    b *= blue_balance;
-    If r > 255 Then
-      r := 255;
-    If g > 255 Then
-      g := 255;
-    If b > 255 Then
-      b := 255;
-    dest^ := (r Shl 16) Or (g Shl 8) Or b;
-    Inc(dest);
+  Try
+    For i := 0 To surface.width * surface.height - 1 Do
+    Begin
+      cv := dest^;
+      r := (cv Shr 16) And 255;
+      g := (cv Shr 8) And 255;
+      b := cv And 255;
+      r *= red_balance;
+      g *= green_balance;
+      b *= blue_balance;
+      If r > 255 Then
+        r := 255;
+      If g > 255 Then
+        g := 255;
+      If b > 255 Then
+        b := 255;
+      dest^ := (r Shl 16) Or (g Shl 8) Or b;
+      Inc(dest);
+    End;
+  Finally
+    surface.unlock;
   End;
-  surface.unlock;
 End;
 
-Procedure grid_map(grid : Pint32; xbase, ybase, xmove, ymove, amp : Single);
+Procedure grid_map(grid : PUint32; xbase, ybase, xmove, ymove, amp : Single);
 
 Var
   x, y : Integer;
@@ -122,8 +133,8 @@ Begin
     Begin
       { it should be noted that there is no scientific basis for }
       { the following three lines :) }
-      grid[0] := int32(Trunc((xbase * 14 + x*4 + xmove*sin(b)+sin(cos(a)*sin(amp))*15) * 65536));
-      grid[1] := int32(Trunc((ybase * 31 + y*3 + ymove*cos(b)*sin(sin(a)*cos(amp))*30) * 65536));
+      grid[0] := Uint32(Trunc((xbase * 14 + x*4 + xmove*sin(b)+sin(cos(a)*sin(amp))*15) * 65536));
+      grid[1] := Uint32(Trunc((ybase * 31 + y*3 + ymove*cos(b)*sin(sin(a)*cos(amp))*30) * 65536));
       id := (cos(xbase) + sin(ybase) + cos(a*xmove*0.17) + sin(b*ymove*0.11)) * amp * 23;
       If id < -127 Then
         grid[2] := 0
@@ -139,7 +150,7 @@ Begin
   End;
 End;
 
-Procedure make_light_table(lighttable : Pchar8);
+Procedure make_light_table(lighttable : PUint8);
 
 Var
   i, j : Integer;
@@ -159,7 +170,7 @@ End;
 
 { if you want to see how to do this properly, look at the tunnel3d demo. }
 { (not included in this distribution :) }
-Procedure texture_warp(dest, grid, texture : Pint32; lighttable : Pchar8);
+Procedure texture_warp(dest, grid, texture : PUint32; lighttable : PUint8);
 
 Var
   utl, utr, ubl, ubr : Integer;
@@ -170,13 +181,13 @@ Var
   bx, by, px, py : Integer;
   uc, vc, ic, ucx, vcx, icx : Integer;
   
-  edi : int32;
-  texel : int32;
+  edi : Uint32;
+  texel : Uint32;
   
-  cbp, dp : Pint32;
-  dpix : int32;
+  cbp, dp : PUint32;
+  dpix : Uint32;
   
-  ltp : Pchar8;
+  ltp : PUint8;
 
 Begin
   cbp := grid;
@@ -259,12 +270,12 @@ Var
   texture : TPTCSurface;
   surface : TPTCSurface;
   console : TPTCConsole;
-  lighttable : Pchar8;
+  lighttable : PUint8;
   { texture grid }
-  grid : Array[0..41*26*3-1] Of int32;
+  grid : Array[0..41*26*3-1] Of Uint32;
   xbase, ybase, xmove, ymove, amp, dct, dxb, dyb, dxm, dym, sa : Single;
   
-  p1, p2 : Pint32;
+  p1, p2 : PUint32;
 
 Begin
   format := Nil;

packages/extra/ptc/demos/tunnel.pp

@@ -23,11 +23,11 @@ Type
     Constructor Create;
     Destructor Destroy; Override;
     Procedure setup;
-    Procedure draw(buffer : Pint32; t : Single);
+    Procedure draw(buffer : PUint32; t : Single);
     Private
     { tunnel data }
-    tunnel : Pint32;
-    texture : Pchar8;
+    tunnel : PUint32;
+    texture : PUint8;
   End;
 
 Constructor TTunnel.Create;
@@ -37,8 +37,8 @@ Begin
   texture := Nil;
   
   { allocate tables }
-  tunnel := GetMem(320*200*SizeOf(int32));
-  texture := GetMem(256*256*2*SizeOf(char8));
+  tunnel := GetMem(320*200*SizeOf(Uint32));
+  texture := GetMem(256*256*2*SizeOf(Uint8));
 
   { setup }
   setup;
@@ -106,11 +106,11 @@ Begin
   End;
 End;
 
-Procedure TTunnel.draw(buffer : Pint32; t : Single);
+Procedure TTunnel.draw(buffer : PUint32; t : Single);
 
 Var
   x, y : Integer;
-  scroll : int32;
+  scroll : Uint32;
   i : Integer;
 
 Begin
@@ -133,7 +133,7 @@ Var
   surface : TPTCSurface;
   TheTunnel : TTunnel;
   time, delta : Single;
-  buffer : Pint32;
+  buffer : PUint32;
 
 Begin
   format := Nil;

packages/extra/ptc/demos/tunnel3d.pp

@@ -19,13 +19,6 @@ Program Tunnel3D;
 Uses
   ptc, Math;
 
-{ for fpc 1.0.10 compatibility... }
-{$IFDEF VER1_0}
-Type
-  PtrUInt = Cardinal;
-  PtrInt = LongInt;
-{$ENDIF VER1_0}
-
 Type
   PVector = ^TVector;
   TVector = Array[0..2] Of Single;      { X,Y,Z }
@@ -40,9 +33,9 @@ Type
 
   TRayTunnel = Class(TObject)
   Private
-    tunneltex : Pchar8;                      { Texture }
-    pal : Pchar8;                            { Original palette }
-    lookup : Pint32;                         { Lookup table for lighting }
+    tunneltex : PUint8;                      { Texture }
+    pal : PUint8;                            { Original palette }
+    lookup : PUint32;                         { Lookup table for lighting }
 
     sintab, costab : PSingle;                { Take a guess }
 
@@ -64,19 +57,19 @@ Type
     Procedure load_texture;
 
     Procedure tilt(x, y, z : Integer);              { Rotate relative }
-    Procedure tilt(x, y, z : Integer; abs : char8); { Absolute }
+    Procedure tilt(x, y, z : Integer; abs : Uint8); { Absolute }
 
     Procedure move(dx, dy, dz : Single);            { Relative move }
-    Procedure move(x, y, z : Single; abs : char8);  { Absolute }
+    Procedure move(x, y, z : Single; abs : Uint8);  { Absolute }
 
     Procedure movelight(dx, dy, dz : Single);
-    Procedure movelight(x, y, z : Single; abs : char8);
+    Procedure movelight(x, y, z : Single; abs : Uint8);
 
     Procedure locklight(lock : Boolean);    { Make the light follow the viewer }
 
     Procedure interpolate;                  { Raytracing }
 
-    Procedure draw(dest : Pint32);          { Draw the finished tunnel }
+    Procedure draw(dest : PUint32);          { Draw the finished tunnel }
   End;
 
 { VECTOR ROUTINES }
@@ -214,8 +207,8 @@ Begin
   l_array := GetMem(64 * 26 * SizeOf(Integer));
   norms := GetMem(64 * 26 * 3 * SizeOf(Single));
 
-  lookup := GetMem(65 * 256 * SizeOf(int32));
-  pal := GetMem(768 * SizeOf(char8));
+  lookup := GetMem(65 * 256 * SizeOf(Uint32));
+  pal := GetMem(768 * SizeOf(Uint8));
 
   For i := 0 To 1023 Do
   Begin
@@ -279,9 +272,9 @@ Procedure TRayTunnel.load_texture;
 
 Var
   texfile : File;
-  tmp : Pchar8;
-  i, j : int32;
-  r, g, b : int32;
+  tmp : PUint8;
+  i, j : Uint32;
+  r, g, b : Uint32;
   newoffs : Integer;
 
 Begin
@@ -420,13 +413,13 @@ Begin
   End;
 End;
 
-Procedure TRayTunnel.draw(dest : Pint32);
+Procedure TRayTunnel.draw(dest : PUint32);
 
 Var
   x, y, lu, lv, ru, rv, liu, liv, riu, riv : Integer;
   iu, iv, i, j, ll, rl, lil, ril, l, il : Integer;
   iadr, adr, til_u, til_v, til_iu, til_iv : DWord;
-  bla : char8;
+  bla : Uint8;
 
 Begin
   For j := 0 To 24 Do
@@ -499,7 +492,7 @@ Begin
   za := (za + z) And $3FF;
 End;
 
-Procedure TRayTunnel.tilt(x, y, z : Integer; abs : char8);
+Procedure TRayTunnel.tilt(x, y, z : Integer; abs : Uint8);
 
 Begin
   xa := x And $3FF;
@@ -516,7 +509,7 @@ Begin
   pos[2] := pos[2] + dz;
 End;
 
-Procedure TRayTunnel.move(x, y, z : Single; abs : char8);
+Procedure TRayTunnel.move(x, y, z : Single; abs : Uint8);
 
 Begin
   pos[0] := x;
@@ -533,7 +526,7 @@ Begin
   light[2] := light[2] + dz;
 End;
 
-Procedure TRayTunnel.movelight(x, y, z : Single; abs : char8);
+Procedure TRayTunnel.movelight(x, y, z : Single; abs : Uint8);
 
 Begin
   light[0] := x;
@@ -555,7 +548,7 @@ Var
   tunnel : TRayTunnel;
   posz, phase_x, phase_y : Single;
   angle_x, angle_y : Integer;
-  buffer : Pint32;
+  buffer : PUint32;
 
 Begin
   format := Nil;

packages/extra/ptc/keyd.inc

@@ -19,7 +19,7 @@
 }
 
 Type
-  TPTCKey=Class(TObject)
+  TPTCKeyEvent=Class(TPTCEvent)
   Private
     m_code : Integer;
     m_unicode : Integer;
@@ -29,6 +29,8 @@ Type
     m_press : Boolean;
     
     Function GetRelease : Boolean;
+  Protected
+    Function GetType : TPTCEventType; Override;
   Public
     Constructor Create;
     Constructor Create(_code : Integer);
@@ -40,10 +42,10 @@ Type
                        _alt, _shift, _control : Boolean);
     Constructor Create(_code, _unicode : Integer;
                        _alt, _shift, _control, _press : Boolean);
-    Constructor Create(Const key : TPTCKey);
+    Constructor Create(Const key : TPTCKeyEvent);
     Destructor Destroy; Override;
-    Procedure Assign(Const key : TPTCKey);
-    Function Equals(Const key : TPTCKey) : Boolean;
+    Procedure Assign(Const key : TPTCKeyEvent);
+    Function Equals(Const key : TPTCKeyEvent) : Boolean;
     Property code : Integer read m_code;
     Property unicode : Integer read m_unicode;
     Property alt : Boolean read m_alt;

packages/extra/ptc/keyi.inc

@@ -18,7 +18,13 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-Constructor TPTCKey.Create;
+Function TPTCKeyEvent.GetType : TPTCEventType;
+
+Begin
+  Result := PTCKeyEvent;
+End;
+
+Constructor TPTCKeyEvent.Create;
 
 Begin
   m_code := Integer(PTCKEY_UNDEFINED);
@@ -29,7 +35,7 @@ Begin
   m_press := True;
 End;
 
-Constructor TPTCKey.Create(_code : Integer);
+Constructor TPTCKeyEvent.Create(_code : Integer);
 
 Begin
   m_code := _code;
@@ -40,7 +46,7 @@ Begin
   m_press := True;
 End;
 
-Constructor TPTCKey.Create(_code, _unicode : Integer);
+Constructor TPTCKeyEvent.Create(_code, _unicode : Integer);
 
 Begin
   m_code := _code;
@@ -51,7 +57,7 @@ Begin
   m_press := True;
 End;
 
-Constructor TPTCKey.Create(_code, _unicode : Integer; _press : Boolean);
+Constructor TPTCKeyEvent.Create(_code, _unicode : Integer; _press : Boolean);
 
 Begin
   m_code := _code;
@@ -62,7 +68,7 @@ Begin
   m_press := _press;
 End;
 
-Constructor TPTCKey.Create(_code : Integer; _alt, _shift, _control : Boolean);
+Constructor TPTCKeyEvent.Create(_code : Integer; _alt, _shift, _control : Boolean);
 
 Begin
   m_code := _code;
@@ -73,7 +79,7 @@ Begin
   m_press := True;
 End;
 
-Constructor TPTCKey.Create(_code : Integer; _alt, _shift, _control, _press : Boolean);
+Constructor TPTCKeyEvent.Create(_code : Integer; _alt, _shift, _control, _press : Boolean);
 
 Begin
   m_code := _code;
@@ -84,7 +90,7 @@ Begin
   m_press := _press;
 End;
 
-Constructor TPTCKey.Create(_code, _unicode : Integer; _alt, _shift, _control : Boolean);
+Constructor TPTCKeyEvent.Create(_code, _unicode : Integer; _alt, _shift, _control : Boolean);
 
 Begin
   m_code := _code;
@@ -95,7 +101,7 @@ Begin
   m_press := True;
 End;
 
-Constructor TPTCKey.Create(_code, _unicode : Integer;
+Constructor TPTCKeyEvent.Create(_code, _unicode : Integer;
                            _alt, _shift, _control, _press : Boolean);
 
 Begin
@@ -107,19 +113,19 @@ Begin
   m_press := _press;
 End;
 
-Constructor TPTCKey.Create(Const key : TPTCKey);
+Constructor TPTCKeyEvent.Create(Const key : TPTCKeyEvent);
 
 Begin
   ASSign(key);
 End;
 
-Destructor TPTCKey.Destroy;
+Destructor TPTCKeyEvent.Destroy;
 
 Begin
   Inherited Destroy;
 End;
 
-Procedure TPTCKey.Assign(Const key : TPTCKey);
+Procedure TPTCKeyEvent.Assign(Const key : TPTCKeyEvent);
 
 Begin
   If Self = key Then
@@ -133,7 +139,7 @@ Begin
   m_press := key.press;
 End;
 
-Function TPTCKey.Equals(Const key : TPTCKey) : Boolean;
+Function TPTCKeyEvent.Equals(Const key : TPTCKeyEvent) : Boolean;
 
 Begin
   Equals := (m_code = key.m_code) And (m_unicode = key.m_unicode) And
@@ -141,7 +147,7 @@ Begin
             (m_control = key.m_control) And (m_press = key.m_press);
 End;
 
-Function TPTCKey.GetRelease : Boolean;
+Function TPTCKeyEvent.GetRelease : Boolean;
 
 Begin
   GetRelease := Not m_press;

packages/extra/ptc/paletted.inc

@@ -25,16 +25,16 @@ Type
     m_handle : THermesHandle;
   Public
     Constructor Create;
-    Constructor Create(Const _data : Array Of int32);
+    Constructor Create(Const _data : Array Of Uint32);
     Constructor Create(Const palette : TPTCPalette);
     Destructor Destroy; Override;
     Procedure Assign(Const palette : TPTCPalette);
     Function Equals(Const palette : TPTCPalette) : Boolean;
-    Function lock : Pint32;
+    Function lock : PUint32;
     Procedure unlock;
-    Procedure load(Const _data : Array Of int32);
+    Procedure load(Const _data : Array Of Uint32);
     Procedure load(_data : Pointer);
-    Procedure save(Var _data : Array Of int32);
+    Procedure save(Var _data : Array Of Uint32);
     Procedure save(_data : Pointer);
-    Function data : Pint32;
+    Function data : PUint32;
   End;

packages/extra/ptc/palettei.inc

@@ -21,7 +21,7 @@
 Constructor TPTCPalette.Create;
 
 Var
-  zero : Array[0..255] Of int32;
+  zero : Array[0..255] Of Uint32;
 
 Begin
   m_locked := False;
@@ -34,7 +34,7 @@ Begin
   load(zero);
 End;
 
-Constructor TPTCPalette.Create(Const _data : Array Of int32);
+Constructor TPTCPalette.Create(Const _data : Array Of Uint32);
 
 Begin
   m_locked := False;
@@ -82,7 +82,7 @@ Begin
   Equals := CompareDWord(Hermes_PaletteGet(m_handle)^, Hermes_PaletteGet(palette.m_handle)^, 1024 Div 4) = 0;
 End;
 
-Function TPTCPalette.lock : Pint32;
+Function TPTCPalette.lock : PUint32;
 
 Begin
   If m_locked Then
@@ -99,7 +99,7 @@ Begin
   m_locked := False;
 End;
 
-Procedure TPTCPalette.load(Const _data : Array Of int32);
+Procedure TPTCPalette.load(Const _data : Array Of Uint32);
 
 Begin
   Hermes_PaletteSet(m_handle, @_data);
@@ -111,7 +111,7 @@ Begin
   Hermes_PaletteSet(m_handle, _data);
 End;
 
-Procedure TPTCPalette.save(Var _data : Array Of int32);
+Procedure TPTCPalette.save(Var _data : Array Of Uint32);
 
 Begin
   Move(Hermes_PaletteGet(m_handle)^, _data, 1024);
@@ -123,7 +123,7 @@ Begin
   Move(Hermes_PaletteGet(m_handle)^, _data^, 1024);
 End;
 
-Function TPTCPalette.data : Pint32;
+Function TPTCPalette.data : PUint32;
 
 Begin
   data := Hermes_PaletteGet(m_handle);

packages/extra/ptc/ptc.pp

@@ -3,12 +3,19 @@
     Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
+    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 program is distributed in the hope that it will be useful,
+    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.
+    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
 }
 
 {$MODE objfpc}
@@ -20,42 +27,52 @@
 
 {$IFDEF UNIX}
 {$DEFINE HAVE_X11_EXTENSIONS_XSHM}
-{$DEFINE XStringListToTextProperty_notyetimplemented_in_xutil_pp}
 {$ENDIF UNIX}
 
 Unit ptc;
 
 Interface
 
+{$IFNDEF FPDOC}
 Uses
-{$IFDEF WIN32}
-  Windows, DirectDraw,
-{$ENDIF WIN32}
-
-{$IFDEF UNIX}
-  x, xlib, xutil, keysym,
-  xf86vmode, xf86dga,
-  {$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-  xshm, ipc,
-  {$ENDIF HAVE_X11_EXTENSIONS_XSHM}
-{$ENDIF UNIX}
-  {SysUtils,} Hermes;
+  Hermes;
+{$ENDIF FPDOC}
 
 Const
-  PTC_VERSION = 'OpenPTC 1.0';
-  PTC_WIN32_VERSION = 'OpenPTC Win32 1.0.18';
+  PTCPAS_VERSION = 'PTCPas 0.99.7';
+{  PTC_WIN32_VERSION = 'OpenPTC Win32 1.0.18';}
 
 Type
-  Pchar8 = ^char8;
-  char8 = Byte;
+  PUint8  = ^Uint8;
+  PUint16 = ^Uint16;
+  PUint32 = ^Uint32;
+  PUint64 = ^Uint64;
+  PSint8  = ^Sint8;
+  PSint16 = ^Sint16;
+  PSint32 = ^Sint32;
+  PSint64 = ^Sint64;
+  Uint8  = Byte;
+  Uint16 = Word;
+  Uint32 = DWord;
+  Uint64 = QWord;
+  Sint8  = ShortInt;
+  Sint16 = SmallInt;
+  Sint32 = LongInt;
+  Sint64 = Int64;
+  {to be deprecated}
+{  Pint32 = ^int32;
+  int32 = Uint32;
   Pshort16 = ^short16;
-  short16 = Word;
-  Pint32 = ^int32;
-  int32 = DWord;
+  short16 = Uint16;
+  Pchar8 = ^char8;
+  char8 = Uint8;}
+  {/to be deprecated}
 {$INCLUDE aread.inc}
 {$INCLUDE colord.inc}
 {$INCLUDE formatd.inc}
+{$INCLUDE eventd.inc}
 {$INCLUDE keyd.inc}
+{$INCLUDE moused.inc}
 {$INCLUDE moded.inc}
 {$INCLUDE paletted.inc}
 {$INCLUDE cleard.inc}
@@ -68,74 +85,51 @@ Type
 {$INCLUDE errord.inc}
 {$INCLUDE timerd.inc}
 
+{$IFNDEF FPDOC}
+
 {$IFDEF ENABLE_C_API}
-{$INCLUDE c_api/index.inc}
-{$INCLUDE c_api/errord.inc}
-{$INCLUDE c_api/exceptd.inc}
-{$INCLUDE c_api/aread.inc}
-{$INCLUDE c_api/colord.inc}
-{$INCLUDE c_api/cleard.inc}
-{$INCLUDE c_api/clipperd.inc}
-{$INCLUDE c_api/copyd.inc}
-{$INCLUDE c_api/keyd.inc}
-{$INCLUDE c_api/formatd.inc}
-{$INCLUDE c_api/paletted.inc}
-{$INCLUDE c_api/surfaced.inc}
-{$INCLUDE c_api/consoled.inc}
-{$INCLUDE c_api/moded.inc}
-{$INCLUDE c_api/timerd.inc}
+{$INCLUDE c_api/index.pp}
+{$INCLUDE c_api/errord.pp}
+{$INCLUDE c_api/exceptd.pp}
+{$INCLUDE c_api/aread.pp}
+{$INCLUDE c_api/colord.pp}
+{$INCLUDE c_api/cleard.pp}
+{$INCLUDE c_api/clipperd.pp}
+{$INCLUDE c_api/copyd.pp}
+{$INCLUDE c_api/keyd.pp}
+{$INCLUDE c_api/formatd.pp}
+{$INCLUDE c_api/paletted.pp}
+{$INCLUDE c_api/surfaced.pp}
+{$INCLUDE c_api/consoled.pp}
+{$INCLUDE c_api/moded.pp}
+{$INCLUDE c_api/timerd.pp}
 {$ENDIF ENABLE_C_API}
 
-{$IFDEF GO32V2}
-{$INCLUDE dos/base/kbdd.inc}
-{$INCLUDE dos/vesa/consoled.inc}
-{$INCLUDE dos/fakemode/consoled.inc}
-{$INCLUDE dos/textfx2/consoled.inc}
-{$INCLUDE dos/cga/consoled.inc}
-{$WARNING should be moved in the implementation part}
-{$ENDIF GO32V2}
-
-{$IFDEF WIN32}
-{$INCLUDE win32/base/monitord.inc}
-{$INCLUDE win32/base/eventd.inc}
-{$INCLUDE win32/base/windowd.inc}
-{$INCLUDE win32/base/hookd.inc}
-{$INCLUDE win32/base/kbdd.inc}
-
-{$INCLUDE win32/directx/hookd.inc}
-{$INCLUDE win32/directx/libraryd.inc}
-{$INCLUDE win32/directx/displayd.inc}
-{$INCLUDE win32/directx/primaryd.inc}
-{$INCLUDE win32/directx/consoled.inc}
-{$WARNING should be moved in the implementation part}
-{$ENDIF WIN32}
-
-{$IFDEF UNIX}
-{$INCLUDE x11/imaged.inc}
-{$INCLUDE x11/displayd.inc}
-{$INCLUDE x11/windowd.inc}
-{$INCLUDE x11/dgadispd.inc}
-{$INCLUDE x11/consoled.inc}
-{$WARNING should be moved in the implementation part}
-{$ENDIF UNIX}
+{$ENDIF FPDOC}
 
 Implementation
 
 {$IFDEF GO32V2}
 Uses
-  textfx2, vesa, vga, cga, timeunit, crt, go32;
+  textfx2, vesa, vga, cga, timeunit, crt, go32, mouse33h;
 {$ENDIF GO32V2}
 
 {$IFDEF WIN32}
-{Uses
-  Windows, DirectDraw;}
+Uses
+  Windows, DirectDraw;
 {$ENDIF WIN32}
 
 {$IFDEF UNIX}
 Uses
-  BaseUnix, Unix;
+  BaseUnix, Unix, ctypes, x, xlib, xutil, xatom, keysym,
+  xf86vmode, xf86dga,
+  {$IFDEF HAVE_X11_EXTENSIONS_XSHM}
+  xshm, ipc;
+  {$ENDIF HAVE_X11_EXTENSIONS_XSHM}
 {$ENDIF UNIX}
 
+{ this little procedure is not a good reason to include the whole sysutils
+  unit :) }
 Procedure FreeAndNil(Var q);
 
 Var
@@ -169,7 +163,9 @@ End;
 {$INCLUDE areai.inc}
 {$INCLUDE colori.inc}
 {$INCLUDE formati.inc}
+{$INCLUDE eventi.inc}
 {$INCLUDE keyi.inc}
+{$INCLUDE mousei.inc}
 {$INCLUDE modei.inc}
 {$INCLUDE palettei.inc}
 {$INCLUDE cleari.inc}
@@ -181,7 +177,15 @@ End;
 {$INCLUDE timeri.inc}
 
 {$IFDEF GO32V2}
+{$INCLUDE dos/base/kbdd.inc}
+{$INCLUDE dos/base/moused.inc}
+{$INCLUDE dos/vesa/consoled.inc}
+{$INCLUDE dos/fakemode/consoled.inc}
+{$INCLUDE dos/textfx2/consoled.inc}
+{$INCLUDE dos/cga/consoled.inc}
+
 {$INCLUDE dos/base/kbd.inc}
+{$INCLUDE dos/base/mousei.inc}
 {$INCLUDE dos/vesa/console.inc}
 {$INCLUDE dos/fakemode/console.inc}
 {$INCLUDE dos/textfx2/console.inc}
@@ -189,11 +193,24 @@ End;
 {$ENDIF GO32V2}
 
 {$IFDEF WIN32}
+{$INCLUDE win32/base/monitord.inc}
+{$INCLUDE win32/base/eventd.inc}
+{$INCLUDE win32/base/windowd.inc}
+{$INCLUDE win32/base/hookd.inc}
+{$INCLUDE win32/base/kbdd.inc}
+{$INCLUDE win32/base/moused.inc}
+{$INCLUDE win32/directx/hookd.inc}
+{$INCLUDE win32/directx/libraryd.inc}
+{$INCLUDE win32/directx/displayd.inc}
+{$INCLUDE win32/directx/primaryd.inc}
+{$INCLUDE win32/directx/consoled.inc}
+
 {$INCLUDE win32/base/monitor.inc}
 {$INCLUDE win32/base/event.inc}
 {$INCLUDE win32/base/window.inc}
 {$INCLUDE win32/base/hook.inc}
 {$INCLUDE win32/base/kbd.inc}
+{$INCLUDE win32/base/mousei.inc}
 {$INCLUDE win32/directx/check.inc}
 {$INCLUDE win32/directx/translte.inc}
 {$INCLUDE win32/directx/hook.inc}
@@ -204,31 +221,39 @@ End;
 {$ENDIF WIN32}
 
 {$IFDEF UNIX}
+{$INCLUDE x11/modesd.inc}
+{$INCLUDE x11/imaged.inc}
+{$INCLUDE x11/displayd.inc}
+{$INCLUDE x11/windowd.inc}
+{$INCLUDE x11/dgadispd.inc}
+{$INCLUDE x11/consoled.inc}
+
 {$INCLUDE x11/check.inc}
-{$INCLUDE x11/image.inc}
-{$INCLUDE x11/display.inc}
-{$INCLUDE x11/window.inc}
-{$INCLUDE x11/dgadisp.inc}
-{$INCLUDE x11/console.inc}
+{$INCLUDE x11/modesi.inc}
+{$INCLUDE x11/imagei.inc}
+{$INCLUDE x11/displayi.inc}
+{$INCLUDE x11/windowi.inc}
+{$INCLUDE x11/dgadispi.inc}
+{$INCLUDE x11/consolei.inc}
 {$ENDIF UNIX}
 
 {$INCLUDE consolei.inc}
 
 {$IFDEF ENABLE_C_API}
-{$INCLUDE c_api/except.inc}
-{$INCLUDE c_api/error.inc}
-{$INCLUDE c_api/area.inc}
-{$INCLUDE c_api/color.inc}
-{$INCLUDE c_api/clear.inc}
-{$INCLUDE c_api/clipper.inc}
-{$INCLUDE c_api/copy.inc}
-{$INCLUDE c_api/key.inc}
-{$INCLUDE c_api/format.inc}
-{$INCLUDE c_api/palette.inc}
-{$INCLUDE c_api/surface.inc}
-{$INCLUDE c_api/console.inc}
-{$INCLUDE c_api/mode.inc}
-{$INCLUDE c_api/timer.inc}
+{$INCLUDE c_api/except.pp}
+{$INCLUDE c_api/error.pp}
+{$INCLUDE c_api/area.pp}
+{$INCLUDE c_api/color.pp}
+{$INCLUDE c_api/clear.pp}
+{$INCLUDE c_api/clipper.pp}
+{$INCLUDE c_api/copy.pp}
+{$INCLUDE c_api/key.pp}
+{$INCLUDE c_api/format.pp}
+{$INCLUDE c_api/palette.pp}
+{$INCLUDE c_api/surface.pp}
+{$INCLUDE c_api/console.pp}
+{$INCLUDE c_api/mode.pp}
+{$INCLUDE c_api/timer.pp}
 {$ENDIF ENABLE_C_API}
 
 Initialization

packages/extra/ptc/x11/check.inc

@@ -20,8 +20,8 @@
 
 Procedure X11Check(result : TStatus);
 
-Var
-  ErrStr : String;
+{Var
+  ErrStr : String;}
 
 Begin
   {todo: fix X11 error handling}

packages/extra/ptc/x11/consoled.inc

@@ -1,21 +1,12 @@
-Const
-  PTC_X11_NODGA = 1;
-  PTC_X11_LEAVE_DISPLAY = 2;
-  PTC_X11_LEAVE_WINDOW = 4;
-  PTC_X11_PEDANTIC_DGA = 8;
-  PTC_X11_DITHER = 16;
-
 Type
   TX11Console = Class(TPTCBaseConsole)
   Private
     Procedure setTitle(_title : String);
+    Procedure UpdateCursor;
     x11disp : TX11Display;
     m_title : String;
-    m_flags : LongInt;
+    m_flags : TX11Flags;
     m_modes : Array[0..255] Of TPTCMode;
-  Protected
-    Procedure internal_ReadKey(k : TPTCKey); Override;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Override;
   Public
     Constructor Create;
     Destructor Destroy; Override;
@@ -74,4 +65,6 @@ Type
     Function name : String; Override;
     Function title : String; Override;
     Function information : String; Override;
+    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override;
   End;

packages/extra/ptc/x11/console.inc → packages/extra/ptc/x11/consolei.inc

@@ -5,19 +5,19 @@ Var
 
 Begin
   x11disp := Nil;
-  m_flags := 0;
+  m_flags := [];
   FillChar(m_modes, SizeOf(m_modes), 0);
   m_title := '';
   
   m_modes[0] := TPTCMode.Create;
   
-  configure('/usr/share/ptc/ptc.conf');
+  configure('/usr/share/ptcpas/ptcpas.conf');
   s := fpgetenv('HOME');
   If s = '' Then
     s := '/';
   If s[Length(s)] <> '/' Then
     s := s + '/';
-  s := s + '.ptc.conf';
+  s := s + '.ptcpas.conf';
   configure(s);
 End;
 
@@ -64,24 +64,63 @@ Function TX11Console.option(Const _option : String) : Boolean;
 
 Begin
   option := True;
-  If _option = 'dga pedantic init' Then
+  If _option = 'default output' Then
   Begin
-    m_flags := m_flags Or PTC_X11_PEDANTIC_DGA;
+    { default is windowed for now }
+    m_flags := m_flags - [PTC_X11_FULLSCREEN];
     Exit;
   End;
-  If _option = 'dga off' Then
+  If _option = 'windowed output' Then
+  Begin
+    m_flags := m_flags - [PTC_X11_FULLSCREEN];
+    Exit;
+  End;
+  If _option = 'fullscreen output' Then
   Begin
-    m_flags := m_flags Or PTC_X11_NODGA;
+    m_flags := m_flags + [PTC_X11_FULLSCREEN];
     Exit;
   End;
   If _option = 'leave window open' Then
   Begin
-    m_flags := m_flags Or PTC_X11_LEAVE_WINDOW;
+    m_flags := m_flags + [PTC_X11_LEAVE_WINDOW];
     Exit;
   End;
   If _option = 'leave display open' Then
   Begin
-    m_flags := m_flags Or PTC_X11_LEAVE_DISPLAY;
+    m_flags := m_flags + [PTC_X11_LEAVE_DISPLAY];
+    Exit;
+  End;
+  If _option = 'dga pedantic init' Then
+  Begin
+    m_flags := m_flags + [PTC_X11_PEDANTIC_DGA, PTC_X11_TRY_DGA];
+    Exit;
+  End;
+  If _option = 'dga' Then
+  Begin
+    m_flags := m_flags + [PTC_X11_TRY_DGA];
+    Exit;
+  End;
+  If _option = 'dga off' Then
+  Begin
+    m_flags := m_flags - [PTC_X11_TRY_DGA];
+    Exit;
+  End;
+  If _option = 'default cursor' Then
+  Begin
+    m_flags := m_flags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE, PTC_X11_WINDOWED_CURSOR_INVISIBLE];
+    UpdateCursor;
+    Exit;
+  End;
+  If _option = 'show cursor' Then
+  Begin
+    m_flags := (m_flags - [PTC_X11_WINDOWED_CURSOR_INVISIBLE]) + [PTC_X11_FULLSCREEN_CURSOR_VISIBLE];
+    UpdateCursor;
+    Exit;
+  End;
+  If _option = 'hide cursor' Then
+  Begin
+    m_flags := (m_flags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE]) + [PTC_X11_WINDOWED_CURSOR_INVISIBLE];
+    UpdateCursor;
     Exit;
   End;
   If x11disp <> Nil Then
@@ -143,11 +182,11 @@ Begin
   
   {ifndef HAVE_DGA}
   
-  If (m_flags And PTC_X11_NODGA) = 0 Then
+  If (PTC_X11_TRY_DGA In m_flags) Then
   Begin
     Try
       x11disp := TX11DGADisplay.Create;
-      x11disp.flags(m_flags Or PTC_X11_LEAVE_DISPLAY);
+      x11disp.flags(m_flags + [PTC_X11_LEAVE_DISPLAY]);
       x11disp.open(_title, _width, _height, _format, disp, screen);
       x11disp.flags(m_flags);
     Except
@@ -161,6 +200,8 @@ Begin
     x11disp.flags(m_flags);
     x11disp.open(_title, _width, _height, _format, disp, screen);
   End;
+  
+  UpdateCursor;
 End;
 
 Procedure TX11Console.open(Const _title : String; Const _mode : TPTCMode;
@@ -200,16 +241,16 @@ Begin
   x11disp.update(_area);
 End;
 
-Procedure TX11Console.internal_ReadKey(k : TPTCKey);
+Function TX11Console.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean;
 
 Begin
-  x11disp.internal_ReadKey(k);
+  Result := x11disp.NextEvent(event, wait, EventMask);
 End;
 
-Function TX11Console.internal_PeekKey(k : TPTCKey) : Boolean;
+Function TX11Console.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent;
 
 Begin
-  Result := x11disp.internal_PeekKey(k);
+  Result := x11disp.PeekEvent(wait, EventMask);
 End;
 
 Procedure TX11Console.copy(Var surface : TPTCBaseSurface);
@@ -386,23 +427,27 @@ Begin
   If x11disp = Nil Then
     Exit('PTC X11');
   information := 'PTC X11, ';
+  If x11disp.isFullScreen Then
+    information := information + 'fullscreen '
+  Else
+    information := information + 'windowed ';
   If x11disp Is TX11WindowDisplay Then
   Begin
     If TX11WindowDisplay(x11disp).m_primary <> Nil Then
     Begin
     {$IFDEF HAVE_X11_EXTENSIONS_XSHM}
       If TX11WindowDisplay(x11disp).m_primary Is TX11SHMImage Then
-        information := information + 'windowed (MIT-Shm) mode'
+        information := information + '(MIT-Shm) '
       Else
     {$ENDIF HAVE_X11_EXTENSIONS_XSHM}
-        information := information + 'windowed (XImage) mode';
+        information := information + '(XImage) ';
     End
     Else
-      information := information + 'windowed mode';
+      information := information + '';
   End
   Else
-    information := information + 'direct graphics access (DGA) mode';
-  information := information + ', ';
+    information := information + '(DGA) ';
+  information := information + 'mode, ';
   Str(x11disp.width, s);
   information := information + s + 'x';
   Str(x11disp.height, s);
@@ -411,6 +456,18 @@ Begin
   information := information + s + ' bit';
 End;
 
+Procedure TX11Console.UpdateCursor;
+
+Begin
+  If Assigned(x11disp) Then
+  Begin
+    If x11disp.isFullScreen Then
+      x11disp.SetCursor(PTC_X11_FULLSCREEN_CURSOR_VISIBLE In m_flags)
+    Else
+      x11disp.SetCursor(Not (PTC_X11_WINDOWED_CURSOR_INVISIBLE In m_flags));
+  End;
+End;
+
 Procedure TX11Console.setTitle(_title : String);
 
 Begin

packages/extra/ptc/x11/dgadispd.inc

@@ -1,8 +1,10 @@
 Type
   TX11DGADisplay = Class(TX11Display)
   Private
-    Procedure internal_ReadKey(k : TPTCKey); Override;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Override;
+    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;
@@ -33,4 +35,6 @@ Type
     Procedure palette(Const _palette : TPTCPalette); Override;
     Function pitch : Integer; Override;
     Function getX11Window : TWindow; Override;
+    Function isFullScreen : Boolean; Override;
+    Procedure SetCursor(visible : Boolean); Override;
   End;

packages/extra/ptc/x11/dgadisp.inc → packages/extra/ptc/x11/dgadispi.inc

@@ -70,7 +70,7 @@ Begin
            (vml^.vdisplay = modeinfo[i]^.vdisplay) Then
         Begin
           previousmode := i;
-          Break;
+	  Break;
         End;
       End;
     Finally
@@ -86,7 +86,7 @@ Begin
   { Find a video mode to set }
   
   { Normal modesetting first, find exactly matching mode }
-  If (m_flags And PTC_X11_PEDANTIC_DGA) = 0 Then
+  If Not (PTC_X11_PEDANTIC_DGA In m_flags) Then
   Begin
     found := False;
     For i := 0 To num_modeinfo - 1 Do
@@ -94,11 +94,11 @@ 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;
+	  Raise TPTCError.Create('Error switching to requested video mode');
+	m_destx := 0;
+	m_desty := 0;
+	found := True;
+	Break;
       End;
     End;
     If Not found Then
@@ -115,7 +115,7 @@ Begin
          (modeinfo[i]^.vdisplay >= _height) Then
       Begin
         found_mode := i;
-        Break;
+	Break;
       End;
     End;
     
@@ -127,7 +127,7 @@ Begin
            (modeinfo[i]^.vdisplay = _height) Then
         Begin
           found_mode := i;
-          Break;
+	  Break;
         End;
       End;
     
@@ -139,13 +139,15 @@ Begin
     Begin
       If (modeinfo[i]^.hdisplay >= _width) And (modeinfo[i]^.vdisplay >= _height) Then
       Begin
-        d_x := sqr(modeinfo[i]^.hdisplay - _width);
-        d_y := sqr(modeinfo[i]^.vdisplay - _height);
-        If (d_x + d_y) < min_diff Then
-        Begin
-          min_diff := d_x + d_y;
-          found_mode := i;
-        End;
+        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;
     
@@ -170,7 +172,7 @@ Begin
   XGrabKeyboard(m_disp, root, True, GrabModeAsync, GrabModeAsync, CurrentTime);
   XGrabPointer(m_disp, root, True, PointerMotionMask Or ButtonPressMask Or
                ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None,
-               CurrentTime);
+	       CurrentTime);
   XFlush(m_disp);
   
   { Get Display information }
@@ -320,63 +322,150 @@ Procedure TX11DGADisplay.update(Const _area : TPTCArea);
 Begin
 End;
 
-Procedure TX11DGADisplay.internal_ReadKey(k : TPTCKey);
+Procedure TX11DGADisplay.HandleEvents;
 
 Var
   e : TXEvent;
-  sym : TKeySym;
-  press : Boolean;
-  alt, shift, ctrl : Boolean;
-  uni : Integer;
-  tmpkey : TPTCKey;
+  NewFocus : Boolean;
+  NewFocusSpecified : Boolean;
 
-Begin
-  XMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e); { Blocks and waits }
-  If (e._type <> KeyPress) And (e._type <> KeyRelease) Then
-    Raise TPTCError.Create('XMaskEvent returned event <> KeyPress/KeyRelease');
+  Function UsefulEventsPending : Boolean;
   
-{  XLookupString(@e.xkey, Nil, 0, @sym, Nil);}
-  sym := XLookupKeySym(@e.xkey, 0);
-  uni := X11ConvertKeySymToUnicode(sym);
-  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;
+  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;
 
-  tmpkey := Nil;
-  Try
+  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 : tmpkey := TPTCKey.Create(m_normalkeys[sym And $FF], uni, alt, shift, ctrl, press);
-      $FF : tmpkey := TPTCKey.Create(m_functionkeys[sym And $FF], uni, alt, shift, ctrl, press);
+      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
-        tmpkey := TPTCKey.Create;
+        key := TPTCKeyEvent.Create;
     End;
-    k.ASSign(tmpkey);
-  Finally
-    tmpkey.Free;
+    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.internal_PeekKey(k : TPTCKey) : Boolean;
+Function TX11DGADisplay.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean;
 
 Var
-  e : TXEvent;
+  tmpEvent : TXEvent;
 
 Begin
-  If XCheckMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e) Then
-  Begin
-    XPutBackEvent(m_disp, @e); { Simulate "normal" kbhit behaviour }
-    XPutBackEvent(m_disp, @e); { i.e. leave the buffer intact }
-    internal_ReadKey(k);
-    Result := True;
-  End
-  Else
-    Result := False;
+  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
@@ -392,7 +481,7 @@ End;
 Procedure TX11DGADisplay.palette(Const _palette : TPTCPalette);
 
 Var
-  pal : Pint32;
+  pal : PUint32;
   i : Integer;
 
 Begin
@@ -422,5 +511,18 @@ End;
 Function TX11DGADisplay.getX11Window : TWindow;
 
 Begin
-  getX11Window := DefaultRootWindow(m_disp);
+  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;

packages/extra/ptc/x11/displayd.inc

@@ -1,8 +1,19 @@
+Type
+  TX11FlagsEnum = (PTC_X11_FULLSCREEN,
+                   PTC_X11_LEAVE_DISPLAY,
+                   PTC_X11_LEAVE_WINDOW,
+		   PTC_X11_TRY_DGA,
+                   PTC_X11_PEDANTIC_DGA,
+                   PTC_X11_DITHER,
+                   PTC_X11_FULLSCREEN_CURSOR_VISIBLE,
+                   PTC_X11_WINDOWED_CURSOR_INVISIBLE);
+  TX11Flags = Set Of TX11FlagsEnum;
+
 Type
   TX11Display = Class(TObject)
   Protected
-    Procedure internal_ReadKey(k : TPTCKey); Virtual; Abstract;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Virtual; Abstract;
+    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Virtual; Abstract;
+    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Virtual; Abstract;
     
     Function getFormat(Const _format : TPTCFormat) : TPTCFormat;
     
@@ -17,7 +28,9 @@ Type
     m_area : TPTCArea;
     m_clip : TPTCArea;
     
-    m_flags : LongInt;
+    FEventQueue : TEventQueue;
+    
+    m_flags : TX11Flags;
     m_width, m_height : DWord;
     m_format : TPTCFormat;
     
@@ -77,6 +90,9 @@ Type
     { console clip area }
     Procedure clip(Const _area : TPTCArea);
     
+    { cursor control }
+    Procedure SetCursor(visible : Boolean); Virtual; Abstract;
+    
     { Data access }
     Function width : Integer;
     Function height : Integer;
@@ -85,8 +101,10 @@ Type
     Function area : TPTCArea;
     Function format : TPTCFormat;
     
+    Function isFullScreen : Boolean; Virtual; Abstract;
+    
     { Set flags (only used internally now!) }
-    Procedure flags(_flags : LongInt);
+    Procedure flags(_flags : TX11Flags);
     
     { X11 helper functions for your enjoyment }
     

packages/extra/ptc/x11/display.inc → packages/extra/ptc/x11/displayi.inc

@@ -6,7 +6,7 @@ Begin
   m_disp := Nil;
   m_colours := Nil;
   m_cmap := 0;
-  m_flags := 0;
+  m_flags := [];
   m_width := 0;
   m_height := 0;
   m_functionkeys := Nil;
@@ -17,6 +17,7 @@ Begin
   m_clip := Nil;
   m_area := Nil;
   m_format := Nil;
+  FEventQueue := Nil;
   
   m_copy := TPTCCopy.Create;
   m_clear := TPTCClear.Create;
@@ -24,6 +25,7 @@ Begin
   m_clip := TPTCArea.Create;
   m_area := TPTCArea.Create;
   m_format := TPTCFormat.Create;
+  FEventQueue := TEventQueue.Create;
   
   setKeyMapping;
 End;
@@ -31,22 +33,15 @@ End;
 Destructor TX11Display.Destroy;
 
 Begin
-//  Writeln('lll1');
   { Just close the display, everything else is done by the subclasses }
-  If (m_disp <> Nil) And ((m_flags And PTC_X11_LEAVE_DISPLAY) = 0) Then
+  If (m_disp <> Nil) And (Not (PTC_X11_LEAVE_DISPLAY In m_flags)) Then
   Begin
-//    Writeln('lalalalala1');
     XFlush(m_disp);
-//    Writeln('lalalalala2');
     XCloseDisplay(m_disp);
-//    Writeln('lalalalala3');
     m_disp := Nil;
-//    Writeln('lalalalala4');
   End;
-//  Writeln('lll2');
   FreeMemAndNil(m_normalkeys);
   FreeMemAndNil(m_functionkeys);
-//  Writeln('lll3');
   
   m_copy.Free;
   m_clear.Free;
@@ -54,6 +49,7 @@ Begin
   m_clip.Free;
   m_area.Free;
   m_format.Free;
+  FEventQueue.Free;
   
   Inherited Destroy;
 End;
@@ -211,7 +207,7 @@ Begin
   format := m_format;
 End;
 
-Procedure TX11Display.flags(_flags : LongInt);
+Procedure TX11Display.flags(_flags : TX11Flags);
 
 Begin
   m_flags := _flags;

packages/extra/ptc/x11/imaged.inc

@@ -15,7 +15,7 @@ Type
   End;
   TX11NormalImage = Class(TX11Image)
   Private
-    m_pixels : Pchar8;
+    m_pixels : PUint8;
   Public
     Constructor Create(display : PDisplay; screen, width, height : Integer; format : TPTCFormat);
     Destructor Destroy; Override;

packages/extra/ptc/x11/window.inc

@@ -1,392 +0,0 @@
-{$IFDEF XStringListToTextProperty_notyetimplemented_in_xutil_pp}
-Function XStringListToTextProperty(list : PPChar; count : Integer;
-                                   text_prop_return : PXTextProperty) : TStatus; CDecl; External;
-{$ENDIF}
-
-Constructor TX11WindowDisplay.Create;
-
-Begin
-  m_has_shm := False;
-  m_primary := Nil;
-  m_window := 0;
-  m_colours := Nil;
-  m_keypressed := False;
-  Inherited Create;
-//  XSHM_LoadLibrary;
-
-{$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-  m_has_shm := True;
-{$ENDIF HAVE_X11_EXTENSIONS_XSHM}
-End;
-
-Destructor TX11WindowDisplay.Destroy;
-
-Begin
-  close;
-//  XSHM_UnloadLibrary;
-  Inherited Destroy;
-End;
-
-Procedure TX11WindowDisplay.open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer);
-
-Var
-  tmpFormat : TPTCFormat;
-  xgcv : TXGCValues;
-  textprop : TXTextProperty;
-  e : TXEvent;
-  found : Boolean;
-  attr : TXSetWindowAttributes;
-  size_hints : PXSizeHints;
-  tmpArea : TPTCArea;
-  tmppchar : PChar;
-
-Begin
-  m_disp := disp;
-  m_screen := DefaultScreen(disp);
-  m_height := _height;
-  m_width := _width;
-  m_destx := 0;
-  m_desty := 0;
-  { Check if we have that colour depth available.. Easy as there is no
-    format conversion yet }
-  tmpFormat := Nil;
-  Try
-    tmpFormat := getFormat(_format);
-    m_format.ASSign(tmpFormat);
-  Finally
-    tmpFormat.Free;
-  End;
-  tmpFormat := Nil;
-  { Create a window }
-  m_window := XCreateSimpleWindow(m_disp, DefaultRootWindow(m_disp), 0, 0,
-                _width, _height, 0, BlackPixel(m_disp, DefaultScreen(m_disp)),
-		                    BlackPixel(m_disp, DefaultScreen(m_disp)));
-  { Register the delete atom }
-  m_atom_close := XInternAtom(m_disp, 'WM_DELETE_WINDOW', False);
-  X11Check(XSetWMProtocols(m_disp, m_window, @m_atom_close, 1), 'XSetWMProtocols');
-  { Get graphics context }
-  xgcv.graphics_exposures := False;
-  m_gc := XCreateGC(m_disp, m_window, GCGraphicsExposures, @xgcv);
-  If m_gc = Nil Then
-    Raise TPTCError.Create('can''t create graphics context');
-  { Set window title }
-  tmppchar := PChar(title);
-  X11Check(XStringListToTextProperty(@tmppchar, 1, @textprop), 'XStringListToTextProperty');
-  Try
-    XSetWMName(m_disp, m_window, @textprop);
-    XFlush(m_disp);
-  Finally
-    XFree(textprop.value);
-  End;
-  { Set normal hints }
-  size_hints := XAllocSizeHints;
-  Try
-    size_hints^.flags := PBaseSize;
-    size_hints^.base_width := _width;
-    size_hints^.base_height := _height;
-    XSetWMNormalHints(m_disp, m_window, size_hints);
-    XFlush(m_disp);
-  Finally
-    XFree(size_hints);
-  End;
-  { Map the window and wait for success }
-  XSelectInput(m_disp, m_window, StructureNotifyMask);
-  XMapRaised(m_disp, m_window);
-  Repeat
-    XNextEvent(disp, @e);
-    If e._type = MapNotify Then
-      Break;
-  Until False;
-  { Get keyboard input and sync }
-  XSelectInput(m_disp, m_window, KeyPressMask Or KeyReleaseMask Or
-                                 StructureNotifyMask Or
-				 ButtonPressMask Or ButtonReleaseMask Or
-				 PointerMotionMask);
-  XSync(m_disp, False);
-  { Create XImage using factory method }
-  m_primary := createImage(m_disp, m_screen, m_width, m_height, m_format);
-  
-  found := False;
-  Repeat
-    { Stupid loop. The key }
-    { events were causing }
-    { problems.. }
-    found := XCheckMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e);
-  Until Not found;
-  
-  attr.backing_store := Always;
-  XChangeWindowAttributes(m_disp, m_window, CWBackingStore, @attr);
-  
-  { Set clipping area }
-  tmpArea := TPTCArea.Create(0, 0, m_width, m_height);
-  Try
-    m_clip.ASSign(tmpArea);
-  Finally
-    tmpArea.Free;
-  End;
-  
-  { Installs the right colour map for 8 bit modes }
-  createColormap;
-
-  {ifdef PTHREADS...}
-End;
-
-Procedure TX11WindowDisplay.open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat);
-
-Begin
-End;
-
-Procedure TX11WindowDisplay.open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer);
-
-Begin
-End;
-
-Procedure TX11WindowDisplay.close;
-
-Begin
-  {pthreads?!}
-  If m_cmap <> 0 Then
-  Begin
-    XFreeColormap(m_disp, m_cmap);
-    m_cmap := 0;
-  End;
-  
-  { Destroy XImage and buffer }
-  FreeAndNil(m_primary);
-  FreeMemAndNil(m_colours);
-  
-  { Hide and destroy window }
-  If (m_window <> 0) And ((m_flags And PTC_X11_LEAVE_WINDOW) = 0) Then
-  Begin
-    XUnmapWindow(m_disp, m_window);
-    XSync(m_disp, False);
-    
-    XDestroyWindow(m_disp, m_window);
-  End;
-End;
-
-Procedure TX11WindowDisplay.update;
-
-Var
-  e : TXEvent;
-
-Begin
-  m_primary.put(m_window, m_gc, m_destx, m_desty);
-  {ifndef pthreads}
-  If XCheckTypedEvent(m_disp, ClientMessage, @e) Then
-  Begin
-    If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then
-      Halt(0);
-  End;
-  {endif}
-End;
-
-Procedure TX11WindowDisplay.update(Const _area : TPTCArea);
-
-Var
-  e : TXEvent;
-  updatearea : TPTCArea;
-  tmparea : TPTCArea;
-
-Begin
-  tmparea := TPTCArea.Create(0, 0, m_width, m_height);
-  Try
-    updatearea := TPTCClipper.clip(tmparea, _area);
-    Try
-      m_primary.put(m_window, m_gc, updatearea.left, updatearea.top,
-                    m_destx + updatearea.left, m_desty + updatearea.top,
-		    updatearea.width, updatearea.height);
-    Finally
-      updatearea.Free;
-    End;
-  Finally
-    tmparea.Free;
-  End;
-  
-  {ifndef pthreads}
-  If XCheckTypedEvent(m_disp, ClientMessage, @e) Then
-  Begin
-    If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then
-      Halt(0);
-  End;
-  {endif}
-End;
-
-Procedure TX11WindowDisplay.internal_ReadKey(k : TPTCKey);
-
-Var
-  e : TXEvent;
-  sym : TKeySym;
-  press : Boolean;
-  alt, shift, ctrl : Boolean;
-  uni : Integer;
-  tmpkey : TPTCKey;
-
-Begin
-  XMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e); { Blocks and waits }
-  If (e._type <> KeyPress) And (e._type <> KeyRelease) Then
-    Raise TPTCError.Create('XMaskEvent returned event <> KeyPress/KeyRelease');
-  
-{  XLookupString(@e.xkey, Nil, 0, @sym, Nil);}
-  sym := XLookupKeySym(@e.xkey, 0);
-  uni := X11ConvertKeySymToUnicode(sym);
-  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;
-
-  tmpkey := Nil;
-  Try
-    Case sym Shr 8 Of
-      0 : tmpkey := TPTCKey.Create(m_normalkeys[sym And $FF], uni, alt, shift, ctrl, press);
-      $FF : tmpkey := TPTCKey.Create(m_functionkeys[sym And $FF], uni, alt, shift, ctrl, press);
-      Else
-        tmpkey := TPTCKey.Create;
-    End;
-    k.ASSign(tmpkey);
-  Finally
-    tmpkey.Free;
-  End;
-End;
-
-Function TX11WindowDisplay.internal_PeekKey(k : TPTCKey) : Boolean;
-
-Var
-  e : TXEvent;
-
-Begin
-  If XCheckMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e) Then
-  Begin
-    XPutBackEvent(m_disp, @e); { Simulate "normal" kbhit behaviour }
-    XPutBackEvent(m_disp, @e); { i.e. leave the buffer intact }
-    internal_ReadKey(k);
-    Result := True;
-  End
-  Else
-    Result := False;
-End;
-
-Function TX11WindowDisplay.lock : Pointer;
-
-Begin
-  lock := m_primary.lock;
-End;
-
-Procedure TX11WindowDisplay.unlock;
-
-Begin
-End;
-
-Procedure TX11WindowDisplay.palette(Const _palette : TPTCPalette);
-
-Var
-  pal : Pint32;
-  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);
-End;
-
-Function TX11WindowDisplay.pitch : Integer;
-
-Begin
-  pitch := m_primary.pitch;
-End;
-
-Function TX11WindowDisplay.createImage(disp : PDisplay; screen, _width, _height : Integer;
-                                       _format : TPTCFormat) : TX11Image;
-
-{$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-Var
-  tmp : TX11Image;
-{$ENDIF}
-
-Begin
-  {todo: shm}
-  {$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-  If m_has_shm And XShmQueryExtension(disp) Then
-  Begin
-    Try
-      tmp := TX11SHMImage.Create(disp, screen, _width, _height, _format);
-    Except
-      On e : TPTCError Do
-        tmp := TX11NormalImage.Create(disp, screen, _width, _height, _format);
-    End;
-    createImage := tmp;
-  End
-  Else
-  {$ENDIF}
-  createImage := TX11NormalImage.Create(disp, screen, _width, _height, _format);
-End;
-
-Function TX11WindowDisplay.getX11Window : TWindow;
-
-Begin
-  getX11Window := m_window;
-End;
-
-Function TX11WindowDisplay.getX11GC : TGC;
-
-Begin
-  getX11GC := m_gc;
-End;
-
-Procedure TX11WindowDisplay.createColormap; { Register colour maps }
-
-Var
-  i : Integer;
-  r, g, b : Single;
-
-Begin
-  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');
-    XInstallColormap(m_disp, m_cmap);
-    XSetWindowColormap(m_disp, m_window, m_cmap);
-  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);
-  End;
-End;

packages/extra/ptc/x11/windowd.inc

@@ -1,9 +1,14 @@
 Type
   TX11WindowDisplay = Class(TX11Display)
   Private
-    Procedure internal_ReadKey(k : TPTCKey); Override;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Override;
+    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override;
     
+    Procedure EnterFullScreen;
+    Procedure LeaveFullScreen;
+    Procedure internal_ShowCursor(visible : Boolean);
+    Procedure HandleChangeFocus(NewFocus : Boolean);
+    Procedure HandleEvents;
     Function createImage(disp : PDisplay; screen, _width, _height : Integer;
                          _format : TPTCFormat) : TX11Image; { Factory method }
     Procedure createColormap; { Register colour maps }
@@ -15,7 +20,18 @@ Type
     m_gc : TGC;
     m_atom_close : TAtom; { X Atom for close window button }
     m_keypressed : Boolean; { Key pressed since the last call to key() ? }
-{    m_keylast : TPTCKey;} { Last key pressed (scancode) }
+{    m_keylast : TPTCKeyEvent;} { Last key pressed (scancode) }
+    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;
     Destructor Destroy; Override;
@@ -32,4 +48,6 @@ Type
     Function pitch : Integer; Override;
     Function getX11Window : TWindow; Override;
     Function getX11GC : TGC; Virtual;
+    Function isFullScreen : Boolean; Override;
+    Procedure SetCursor(visible : Boolean); Override;
   End;

packages/extra/ptc/x11/windowi.inc

@@ -0,0 +1,713 @@
+Constructor TX11WindowDisplay.Create;
+
+Begin
+  m_has_shm := False;
+  m_primary := Nil;
+  m_window := 0;
+  m_colours := Nil;
+  m_keypressed := False;
+  FFullScreen := False;
+  FPreviousMousePositionSaved := False;
+  FFocus := True;
+  FModeSwitcher := Nil;
+  FX11InvisibleCursor := None;
+  FCursorVisible := True;
+  Inherited Create;
+//  XSHM_LoadLibrary;
+
+{$IFDEF HAVE_X11_EXTENSIONS_XSHM}
+  m_has_shm := True;
+{$ENDIF HAVE_X11_EXTENSIONS_XSHM}
+End;
+
+Destructor TX11WindowDisplay.Destroy;
+
+Begin
+  close;
+//  XSHM_UnloadLibrary;
+  Inherited Destroy;
+End;
+
+Procedure TX11WindowDisplay.open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer);
+
+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
+  m_disp := disp;
+  m_screen := DefaultScreen(disp);
+  m_height := _height;
+  m_width := _width;
+  m_destx := 0;
+  m_desty := 0;
+  
+  FFullScreen := PTC_X11_FULLSCREEN In m_flags;
+  
+  FFocus := True;
+
+  FPreviousMousePositionSaved := False;
+
+  FillChar(BlackColor, SizeOf(BlackColor), 0);
+  BlackColor.red := 0;
+  BlackColor.green := 0;
+  BlackColor.blue := 0;
+
+  { Create the mode switcher object }
+  If FFullScreen Then
+    Try
+      FModeSwitcher := TX11Modes.Create(m_disp, m_screen);
+    Except
+      On error : TPTCError Do
+      Begin
+        {todo: log the error}
+        FModeSwitcher := Nil;
+      End;
+    End;
+
+  { Create the invisible cursor }
+  tmpPixmap := XCreateBitmapFromData(m_disp, RootWindow(m_disp, m_screen), @BlankCursorData, 8, 8);
+  Try
+    FX11InvisibleCursor := XCreatePixmapCursor(m_disp, tmpPixmap, tmpPixmap, @BlackColor, @BlackColor, 0, 0);
+  Finally
+    If tmpPixmap <> None Then
+      XFreePixmap(m_disp, tmpPixmap);
+  End;
+
+  { Check if we have that colour depth available.. Easy as there is no
+    format conversion yet }
+  tmpFormat := Nil;
+  Try
+    tmpFormat := getFormat(_format);
+    m_format.ASSign(tmpFormat);
+  Finally
+    tmpFormat.Free;
+  End;
+  tmpFormat := Nil;
+  
+  { Create a window }
+  m_window := XCreateSimpleWindow(m_disp, RootWindow(m_disp, m_screen), 0, 0,
+                _width, _height, 0, BlackPixel(m_disp, m_screen),
+		                    BlackPixel(m_disp, m_screen));
+  { Register the delete atom }
+  m_atom_close := XInternAtom(m_disp, 'WM_DELETE_WINDOW', False);
+  X11Check(XSetWMProtocols(m_disp, m_window, @m_atom_close, 1), 'XSetWMProtocols');
+  { Get graphics context }
+  xgcv.graphics_exposures := False;
+  m_gc := XCreateGC(m_disp, m_window, GCGraphicsExposures, @xgcv);
+  If m_gc = Nil Then
+    Raise TPTCError.Create('can''t create graphics context');
+  { Set window title }
+  tmppchar := PChar(title);
+  X11Check(XStringListToTextProperty(@tmppchar, 1, @textprop), 'XStringListToTextProperty');
+  Try
+    XSetWMName(m_disp, m_window, @textprop);
+    XFlush(m_disp);
+  Finally
+    XFree(textprop.value);
+  End;
+  
+  { Set normal hints }
+  size_hints := XAllocSizeHints;
+  Try
+    size_hints^.flags := PMinSize Or PBaseSize;
+    size_hints^.min_width := _width;
+    size_hints^.min_height := _height;
+    size_hints^.base_width := _width;
+    size_hints^.base_height := _height;
+    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 := _width;
+      size_hints^.max_height := _height;
+    End;
+    XSetWMNormalHints(m_disp, m_window, size_hints);
+    XFlush(m_disp);
+  Finally
+    XFree(size_hints);
+  End;
+  
+  { Set the _NET_WM_STATE property }
+  If FFullScreen Then
+  Begin
+    tmpArrayOfCLong[1] := XInternAtom(m_disp, '_NET_WM_STATE_FULLSCREEN', False);
+    
+    XChangeProperty(m_disp, m_window, 
+                    XInternAtom(m_disp, '_NET_WM_STATE', False),
+		    XA_ATOM,
+		    32, PropModeReplace, @tmpArrayOfCLong, 1);
+  End;
+  
+  { Map the window and wait for success }
+  XSelectInput(m_disp, m_window, StructureNotifyMask);
+  XMapRaised(m_disp, m_window);
+  Repeat
+    XNextEvent(disp, @e);
+    If e._type = MapNotify Then
+      Break;
+  Until False;
+  { Get keyboard input and sync }
+  XSelectInput(m_disp, m_window, KeyPressMask Or KeyReleaseMask Or
+                                 StructureNotifyMask Or FocusChangeMask Or
+				 ButtonPressMask Or ButtonReleaseMask Or
+				 PointerMotionMask);
+  XSync(m_disp, False);
+  { Create XImage using factory method }
+  m_primary := createImage(m_disp, m_screen, m_width, m_height, m_format);
+  
+  found := False;
+  Repeat
+    { Stupid loop. The key }
+    { events were causing }
+    { problems.. }
+    found := XCheckMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e);
+  Until Not found;
+  
+  attr.backing_store := Always;
+  XChangeWindowAttributes(m_disp, m_window, CWBackingStore, @attr);
+  
+  { Set clipping area }
+  tmpArea := TPTCArea.Create(0, 0, m_width, m_height);
+  Try
+    m_clip.ASSign(tmpArea);
+  Finally
+    tmpArea.Free;
+  End;
+  
+  { Installs the right colour map for 8 bit modes }
+  createColormap;
+
+  If FFullScreen Then
+    EnterFullScreen;
+End;
+
+Procedure TX11WindowDisplay.open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat);
+
+Begin
+End;
+
+Procedure TX11WindowDisplay.open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer);
+
+Begin
+End;
+
+Procedure TX11WindowDisplay.close;
+
+Begin
+  FreeAndNil(FModeSwitcher);
+
+  {pthreads?!}
+  If m_cmap <> 0 Then
+  Begin
+    XFreeColormap(m_disp, m_cmap);
+    m_cmap := 0;
+  End;
+  
+  { Destroy XImage and buffer }
+  FreeAndNil(m_primary);
+  FreeMemAndNil(m_colours);
+  
+  { Hide and destroy window }
+  If (m_window <> 0) And (Not (PTC_X11_LEAVE_WINDOW In m_flags)) Then
+  Begin
+    XUnmapWindow(m_disp, m_window);
+    XSync(m_disp, False);
+    
+    XDestroyWindow(m_disp, m_window);
+  End;
+  
+  { Free the invisible cursor }
+  If FX11InvisibleCursor <> None Then
+  Begin
+    XFreeCursor(m_disp, FX11InvisibleCursor);
+    FX11InvisibleCursor := None;
+  End;
+End;
+
+Procedure TX11WindowDisplay.internal_ShowCursor(visible : Boolean);
+
+Var
+  attr : TXSetWindowAttributes;
+
+Begin
+  If visible Then
+    attr.cursor := None { Use the normal cursor }
+  Else
+    attr.cursor := FX11InvisibleCursor; { Set the invisible cursor }
+  
+  XChangeWindowAttributes(m_disp, m_window, CWCursor, @attr);
+End;
+
+Procedure TX11WindowDisplay.SetCursor(visible : Boolean);
+
+Begin
+  FCursorVisible := visible;
+  
+  If FFocus Then
+    internal_ShowCursor(FCursorVisible);
+End;
+
+Procedure TX11WindowDisplay.EnterFullScreen;
+
+Begin
+  { Try to switch mode }
+  If Assigned(FModeSwitcher) Then
+    FModeSwitcher.SetBestMode(m_width, m_height);
+
+  XSync(m_disp, False);
+End;
+
+Procedure TX11WindowDisplay.LeaveFullScreen;
+
+Begin
+  { Restore previous mode }
+  If Assigned(FModeSwitcher) Then
+    FModeSwitcher.RestorePreviousMode;
+
+  XSync(m_disp, False);
+End;
+
+Procedure TX11WindowDisplay.HandleChangeFocus(NewFocus : Boolean);
+
+Begin
+  { No change? }
+  If NewFocus = FFocus Then
+    Exit;
+
+  FFocus := NewFocus;
+  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(m_disp, False);
+End;
+
+Procedure TX11WindowDisplay.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;
+  
+  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 < m_width) And (y >= 0) And (y < m_height) 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(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, MotionNotify : HandleMouseEvent;
+    End;
+  End;
+  If NewFocusSpecified Then
+    HandleChangeFocus(NewFocus);
+End;
+
+Procedure TX11WindowDisplay.update;
+
+Begin
+  m_primary.put(m_window, m_gc, m_destx, m_desty);
+  
+  HandleEvents;
+End;
+
+Procedure TX11WindowDisplay.update(Const _area : TPTCArea);
+
+Var
+  updatearea : TPTCArea;
+  tmparea : TPTCArea;
+
+Begin
+  tmparea := TPTCArea.Create(0, 0, m_width, m_height);
+  Try
+    updatearea := TPTCClipper.clip(tmparea, _area);
+    Try
+      m_primary.put(m_window, m_gc, updatearea.left, updatearea.top,
+                    m_destx + updatearea.left, m_desty + updatearea.top,
+		    updatearea.width, updatearea.height);
+    Finally
+      updatearea.Free;
+    End;
+  Finally
+    tmparea.Free;
+  End;
+  
+  HandleEvents;
+End;
+
+Function TX11WindowDisplay.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 TX11WindowDisplay.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 TX11WindowDisplay.lock : Pointer;
+
+Begin
+  lock := m_primary.lock;
+End;
+
+Procedure TX11WindowDisplay.unlock;
+
+Begin
+End;
+
+Procedure TX11WindowDisplay.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);
+End;
+
+Function TX11WindowDisplay.pitch : Integer;
+
+Begin
+  pitch := m_primary.pitch;
+End;
+
+Function TX11WindowDisplay.createImage(disp : PDisplay; screen, _width, _height : Integer;
+                                       _format : TPTCFormat) : TX11Image;
+
+{$IFDEF HAVE_X11_EXTENSIONS_XSHM}
+Var
+  tmp : TX11Image;
+{$ENDIF}
+
+Begin
+  {todo: shm}
+  {$IFDEF HAVE_X11_EXTENSIONS_XSHM}
+  If m_has_shm And XShmQueryExtension(disp) Then
+  Begin
+    Try
+      tmp := TX11SHMImage.Create(disp, screen, _width, _height, _format);
+    Except
+      On e : TPTCError Do
+        tmp := TX11NormalImage.Create(disp, screen, _width, _height, _format);
+    End;
+    createImage := tmp;
+  End
+  Else
+  {$ENDIF}
+  createImage := TX11NormalImage.Create(disp, screen, _width, _height, _format);
+End;
+
+Function TX11WindowDisplay.getX11Window : TWindow;
+
+Begin
+  getX11Window := m_window;
+End;
+
+Function TX11WindowDisplay.getX11GC : TGC;
+
+Begin
+  getX11GC := m_gc;
+End;
+
+Function TX11WindowDisplay.isFullScreen : Boolean;
+
+Begin
+  Result := FFullScreen;
+End;
+
+Procedure TX11WindowDisplay.createColormap; { Register colour maps }
+
+Var
+  i : Integer;
+  r, g, b : Single;
+
+Begin
+  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');
+    XInstallColormap(m_disp, m_cmap);
+    XSetWindowColormap(m_disp, m_window, m_cmap);
+  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);
+  End;
+End;