paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 20:29:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r33511 into '.':

Browse Source 
A    packages/ptc/src/cocoa
A    packages/ptc/src/cocoa/cocoaconsoled.inc
A    packages/ptc/src/cocoa/cocoaconsolei.inc
U    packages/ptc/src/ptc.pp
U    packages/ptc/src/core/consolei.inc
U    packages/ptc/src/core/keyeventd.inc
U    packages/ptc/src/core/keyeventi.inc
U    packages/ptc/src/x11/x11displayi.inc
U    packages/ptc/src/x11/x11windowdisplayi.inc
U    packages/ptc/docs/CHANGES.txt
U    packages/ptc/docs/README.txt
--- Recording mergeinfo for merge of r33511 into '.':
 U   .

# revisions: 33511

git-svn-id: branches/fixes_3_0@33513 -
This commit is contained in:
marco 2016-04-15 07:02:10 +00:00
parent b3e34efbf3
commit 31ab63461e
11 changed files with 1201 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -6451,6 +6451,8 @@ packages/ptc/src/c_api/capi_surface.inc svneol=native#text/plain
packages/ptc/src/c_api/capi_surfaced.inc svneol=native#text/plain packages/ptc/src/c_api/capi_surfaced.inc svneol=native#text/plain
packages/ptc/src/c_api/capi_timer.inc svneol=native#text/plain packages/ptc/src/c_api/capi_timer.inc svneol=native#text/plain
packages/ptc/src/c_api/capi_timerd.inc svneol=native#text/plain packages/ptc/src/c_api/capi_timerd.inc svneol=native#text/plain
packages/ptc/src/cocoa/cocoaconsoled.inc svneol=native#text/plain
packages/ptc/src/cocoa/cocoaconsolei.inc svneol=native#text/plain
packages/ptc/src/core/aread.inc svneol=native#text/plain packages/ptc/src/core/aread.inc svneol=native#text/plain
packages/ptc/src/core/areai.inc svneol=native#text/plain packages/ptc/src/core/areai.inc svneol=native#text/plain
packages/ptc/src/core/baseconsoled.inc svneol=native#text/plain packages/ptc/src/core/baseconsoled.inc svneol=native#text/plain

5
packages/ptc/docs/CHANGES.txt
View File

@ -1,3 +1,8 @@
0.99.14.1
- fixed X11 middle and right mouse button mapping. Previously, the right mouse
button and the middle mouse button were swapped, compared to Windows and DOS
and contrary to the documentation.
0.99.14 0.99.14
- added new unit ptcmouse for use with ptcgraph & ptccrt applications. It is - added new unit ptcmouse for use with ptcgraph & ptccrt applications. It is
similar to the winmouse and msmouse units. similar to the winmouse and msmouse units.

2
packages/ptc/docs/README.txt
View File

@ -1,4 +1,4 @@
PTCPas 0.99.14 PTCPas 0.99.14.1
Nikolay Nikolov (nickysn@users.sourceforge.net) Nikolay Nikolov (nickysn@users.sourceforge.net)
PTCPas is a free, portable framebuffer library, written in Free Pascal. It is PTCPas is a free, portable framebuffer library, written in Free Pascal. It is

168
packages/ptc/src/cocoa/cocoaconsoled.inc Normal file
View File

@ -0,0 +1,168 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2015 Nikolay Nikolov (nickysn@users.sourceforge.net)
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version
with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
type
TCocoaConsole = class;
{ NSPTCWindowDelegate }
NSPTCWindowDelegate = objcclass(NSObject, NSWindowDelegateProtocol)
private
FConsole: TCocoaConsole;
public
function windowShouldClose(sender: id): Boolean;
end;
{ NSPTCWindow }
NSPTCWindow = objcclass(NSWindow, NSWindowDelegateProtocol)
private
FConsole: TCocoaConsole;
public
procedure keyDown(theEvent: NSEvent); override;
procedure keyUp(theEvent: NSEvent); override;
procedure flagsChanged(theEvent: NSEvent); override;
procedure mouseDown(theEvent: NSEvent); override;
procedure mouseDragged(theEvent: NSEvent); override;
procedure mouseEntered(theEvent: NSEvent); override;
procedure mouseExited(theEvent: NSEvent); override;
procedure mouseMoved(theEvent: NSEvent); override;
procedure mouseUp(theEvent: NSEvent); override;
procedure rightMouseDown(theEvent: NSEvent); override;
procedure rightMouseDragged(theEvent: NSEvent); override;
procedure rightMouseUp(theEvent: NSEvent); override;
procedure otherMouseDown(theEvent: NSEvent); override;
procedure otherMouseDragged(theEvent: NSEvent); override;
procedure otherMouseUp(theEvent: NSEvent); override;
end;
{ TCocoaConsole }
TCocoaConsole = class(TPTCOpenGLLessConsole)
private
FTitle: string;
FWidth, FHeight, FPitch: Integer;
FFormat: IPTCFormat;
FCopy: TPTCCopy;
FClear: TPTCClear;
FPalette: IPTCPalette;
FArea: IPTCArea;
FClip: IPTCArea;
FEventQueue: TEventQueue;
FInterceptClose: Boolean;
FWindowDelegate: NSPTCWindowDelegate;
FWindow: NSPTCWindow;
FImageRep: NSBitmapImageRep;
FImage: NSImage;
FView: NSView;
class procedure MaybeCreateAutoreleasePool;
function GetWidth: Integer; override;
function GetHeight: Integer; override;
function GetPitch: Integer; override;
function GetArea: IPTCArea; override;
function GetFormat: IPTCFormat; override;
function GetPages: Integer; override;
function GetName: string; override;
function GetTitle: string; override;
function GetInformation: string; override;
function TranslateKeyCode(kcode: cushort): Integer;
function HandleCocoaKeyEvent(theEvent: NSEvent; const Method: string): Boolean;
function HandleCocoaMouseEvent(theEvent: NSEvent; const Method: string): Boolean;
function HandleWindowShouldClose(sender: id): Boolean;
procedure HandleEvents;
property InterceptClose: Boolean read FInterceptClose write FInterceptClose;
public
constructor Create; override;
destructor Destroy; override;
procedure Copy(ASurface: IPTCSurface); override;
procedure Copy(ASurface: IPTCSurface;
ASource, ADestination: IPTCArea); override;
function Lock: Pointer; override;
procedure Unlock; override;
procedure Load(const APixels: Pointer;
AWidth, AHeight, APitch: Integer;
AFormat: IPTCFormat;
APalette: IPTCPalette); override;
procedure Load(const APixels: Pointer;
AWidth, AHeight, APitch: Integer;
AFormat: IPTCFormat;
APalette: IPTCPalette;
ASource, ADestination: IPTCArea); override;
procedure Save(APixels: Pointer;
AWidth, AHeight, APitch: Integer;
AFormat: IPTCFormat;
APalette: IPTCPalette); override;
procedure Save(APixels: Pointer;
AWidth, AHeight, APitch: Integer;
AFormat: IPTCFormat;
APalette: IPTCPalette;
ASource, ADestination: IPTCArea); override;
procedure Clear; override;
procedure Clear(AColor: IPTCColor); override;
procedure Clear(AColor: IPTCColor;
AArea: IPTCArea); override;
procedure Palette(APalette: IPTCPalette); override;
procedure Clip(AArea: IPTCArea); override;
function Option(const AOption: String): Boolean; override;
function Clip: IPTCArea; override;
function Palette: IPTCPalette; override;
procedure Configure(const AFileName: String); override;
function Modes: TPTCModeList; override;
procedure Open(const ATitle: string; APages: Integer = 0); overload; override;
procedure Open(const ATitle: string; AFormat: IPTCFormat;
APages: Integer = 0); overload; override;
procedure Open(const ATitle: string; AWidth, AHeight: Integer;
AFormat: IPTCFormat; APages: Integer = 0); overload; override;
procedure Open(const ATitle: string; AMode: IPTCMode;
APages: Integer = 0); overload; override;
procedure Close; override;
procedure Flush; override;
procedure Finish; override;
procedure Update; override;
procedure Update(AArea: IPTCArea); override;
{ event handling }
function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
end;

829
packages/ptc/src/cocoa/cocoaconsolei.inc Normal file
View File

@ -0,0 +1,829 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2015 Nikolay Nikolov (nickysn@users.sourceforge.net)
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version
with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
threadvar
AutoreleasePool: NSAutoreleasePool;
function NSWStr(const ws: WideString): NSString;
begin
if Length(ws) = 0 then
Result := NSString.alloc.init
else
Result := NSString.alloc.initWithCharacters_length(@ws[1], Length(ws));
end;
{ NSPTCWindowDelegate }
function NSPTCWindowDelegate.windowShouldClose(sender: id): Boolean;
begin
if Assigned(FConsole) then
Result := FConsole.HandleWindowShouldClose(sender)
else
Result := True;
end;
{ NSPTCWindow }
procedure NSPTCWindow.keyDown(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaKeyEvent(theEvent, 'keyDown')) then
{inherited};
end;
procedure NSPTCWindow.keyUp(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaKeyEvent(theEvent, 'keyUp')) then
{inherited};
end;
procedure NSPTCWindow.flagsChanged(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaKeyEvent(theEvent, 'flagsChanged')) then
{inherited};
end;
procedure NSPTCWindow.mouseDown(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'mouseDown')) then
inherited;
end;
procedure NSPTCWindow.mouseDragged(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'mouseDragged')) then
inherited;
end;
procedure NSPTCWindow.mouseEntered(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'mouseEntered')) then
inherited;
end;
procedure NSPTCWindow.mouseExited(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'mouseExited')) then
inherited;
end;
procedure NSPTCWindow.mouseMoved(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'mouseMoved')) then
inherited;
end;
procedure NSPTCWindow.mouseUp(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'mouseUp')) then
inherited;
end;
procedure NSPTCWindow.rightMouseDown(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'rightMouseDown')) then
inherited;
end;
procedure NSPTCWindow.rightMouseDragged(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'rightMouseDragged')) then
inherited;
end;
procedure NSPTCWindow.rightMouseUp(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'rightMouseUp')) then
inherited;
end;
procedure NSPTCWindow.otherMouseDown(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'otherMouseDown')) then
inherited;
end;
procedure NSPTCWindow.otherMouseDragged(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'otherMouseDragged')) then
inherited;
end;
procedure NSPTCWindow.otherMouseUp(theEvent: NSEvent);
begin
if not (Assigned(FConsole) and FConsole.HandleCocoaMouseEvent(theEvent, 'otherMouseUp')) then
inherited;
end;
{ TCocoaConsole }
class procedure TCocoaConsole.MaybeCreateAutoreleasePool;
begin
if AutoreleasePool = nil then
AutoreleasePool := NSAutoreleasePool.new;
end;
function TCocoaConsole.GetWidth: Integer;
begin
Result := FWidth;
end;
function TCocoaConsole.GetHeight: Integer;
begin
Result := FHeight;
end;
function TCocoaConsole.GetPitch: Integer;
begin
Result := FPitch;
end;
function TCocoaConsole.GetArea: IPTCArea;
begin
FArea := TPTCArea.Create(0, 0, FWidth, FHeight);
Result := FArea;
end;
function TCocoaConsole.GetFormat: IPTCFormat;
begin
Result := FFormat;
end;
function TCocoaConsole.GetPages: Integer;
begin
Result := 1;
end;
function TCocoaConsole.GetName: string;
begin
Result := 'Cocoa';
end;
function TCocoaConsole.GetTitle: string;
begin
Result := FTitle;
end;
function TCocoaConsole.GetInformation: string;
begin
Result := '';
end;
function TCocoaConsole.TranslateKeyCode(kcode: cushort): Integer;
begin
case kcode of
10: exit(0); // Section sign (U+00A7)
18: exit(PTCKEY_ONE);
19: exit(PTCKEY_TWO);
20: exit(PTCKEY_THREE);
21: exit(PTCKEY_FOUR);
23: exit(PTCKEY_FIVE);
22: exit(PTCKEY_SIX);
26: exit(PTCKEY_SEVEN);
28: exit(PTCKEY_EIGHT);
25: exit(PTCKEY_NINE);
29: exit(PTCKEY_ZERO);
27: exit(PTCKEY_MINUS);
24: exit(PTCKEY_EQUALS);
51: exit(PTCKEY_BACKSPACE);
48: exit(PTCKEY_TAB);
12: exit(PTCKEY_Q);
13: exit(PTCKEY_W);
14: exit(PTCKEY_E);
15: exit(PTCKEY_R);
17: exit(PTCKEY_T);
16: exit(PTCKEY_Y);
32: exit(PTCKEY_U);
34: exit(PTCKEY_I);
31: exit(PTCKEY_O);
35: exit(PTCKEY_P);
33: exit(PTCKEY_OPENBRACKET);
30: exit(PTCKEY_CLOSEBRACKET);
36: exit(PTCKEY_ENTER);
0: exit(PTCKEY_A);
1: exit(PTCKEY_S);
2: exit(PTCKEY_D);
3: exit(PTCKEY_F);
5: exit(PTCKEY_G);
4: exit(PTCKEY_H);
38: exit(PTCKEY_J);
40: exit(PTCKEY_K);
37: exit(PTCKEY_L);
41: exit(PTCKEY_SEMICOLON);
39: exit(0); // '
42: exit(PTCKEY_BACKSLASH);
50: exit(PTCKEY_BACKQUOTE);
6: exit(PTCKEY_Z);
7: exit(PTCKEY_X);
8: exit(PTCKEY_C);
9: exit(PTCKEY_V);
11: exit(PTCKEY_B);
45: exit(PTCKEY_N);
46: exit(PTCKEY_M);
43: exit(PTCKEY_COMMA);
47: exit(PTCKEY_PERIOD);
44: exit(PTCKEY_SLASH);
49: exit(PTCKEY_SPACE);
53: exit(PTCKEY_ESCAPE);
126: exit(PTCKEY_UP);
123: exit(PTCKEY_LEFT);
125: exit(PTCKEY_DOWN);
124: exit(PTCKEY_RIGHT);
122: exit(PTCKEY_F1);
120: exit(PTCKEY_F2);
99: exit(PTCKEY_F3);
118: exit(PTCKEY_F4);
96: exit(PTCKEY_F5);
97: exit(PTCKEY_F6);
98: exit(PTCKEY_F7);
100: exit(PTCKEY_F8);
101: exit(PTCKEY_F9);
109: exit(PTCKEY_F10);
103: exit(PTCKEY_F11);
111: exit(PTCKEY_F12);
105: exit(0); // F13
107: exit(0); // F14
113: exit(0); // F15
106: exit(0); // F16
64: exit(0); // F17
79: exit(0); // F18
80: exit(0); // F19
115: exit(PTCKEY_HOME);
119: exit(PTCKEY_END);
116: exit(PTCKEY_PAGEUP);
121: exit(PTCKEY_PAGEDOWN);
117: exit(PTCKEY_DELETE);
56, // Left Shift
60: exit(PTCKEY_SHIFT); // Right Shift
59, // Left Ctrl
62: exit(PTCKEY_CONTROL); // Right Ctrl
58, // Left Option (Alt) key
61: exit(PTCKEY_ALT); // Right Option (Alt) key
55, // Left Command key
54: exit(0); // Right Command key
57: exit(PTCKEY_CAPSLOCK);
82: exit(PTCKEY_NUMPAD0);
83: exit(PTCKEY_NUMPAD1);
84: exit(PTCKEY_NUMPAD2);
85: exit(PTCKEY_NUMPAD3);
86: exit(PTCKEY_NUMPAD4);
87: exit(PTCKEY_NUMPAD5);
88: exit(PTCKEY_NUMPAD6);
89: exit(PTCKEY_NUMPAD7);
91: exit(PTCKEY_NUMPAD8);
92: exit(PTCKEY_NUMPAD9);
71: exit(0); // Clear (Num Lock???)
81: exit(0); // numpad '='
75: exit(PTCKEY_DIVIDE);
67: exit(PTCKEY_MULTIPLY);
78: exit(PTCKEY_SUBTRACT);
69: exit(PTCKEY_ADD);
76: exit(PTCKEY_ENTER); // numpad 'Enter'
65: exit(PTCKEY_DECIMAL);
else
exit(0);
end;
end;
function TCocoaConsole.HandleCocoaKeyEvent(theEvent: NSEvent;
const Method: string): Boolean;
var
evtype: NSEventType;
kcode: cushort;
modflags: NSUInteger;
Code, UniCode: Integer;
Alt, Shift, Control: Boolean;
Press: Boolean;
PressAndRelease: Boolean = False;
begin
evtype := theEvent.type_;
kcode := theEvent.keyCode;
modflags := theEvent.modifierFlags;
LOG('cocoa key event ' + Method + ' type=' + IntToStr(evtype) + ' keyCode=' + IntToStr(kcode) + ' modifierFlags=' + IntToStr(modflags));
Result := False;
Code := TranslateKeyCode(kcode);
Unicode := 32;
Alt := (modflags and NSAlternateKeyMask) <> 0;
Shift := (modflags and NSShiftKeyMask) <> 0;
Control := (modflags and NSControlKeyMask) <> 0;
case evtype of
NSKeyDown: Press := True;
NSKeyUp: Press := False;
NSFlagsChanged:
begin
case Code of
PTCKEY_SHIFT: Press := Shift;
PTCKEY_CONTROL: Press := Control;
PTCKEY_ALT: Press := Alt;
PTCKEY_CAPSLOCK:
begin
{ we only receive a modifierFlags message when caps lock is pressed down,
but not when it goes up, so we enqueue both press and release on the
ptc event queue }
PressAndRelease := True;
end;
else
begin
LOG('Unknown NSFlagsChanged key code');
exit;
end;
end;
end;
end;
if PressAndRelease then
begin
FEventQueue.AddEvent(TPTCKeyEventFactory.CreateNew(Code, Unicode, Alt, Shift, Control, True));
FEventQueue.AddEvent(TPTCKeyEventFactory.CreateNew(Code, Unicode, Alt, Shift, Control, False));
end
else
FEventQueue.AddEvent(TPTCKeyEventFactory.CreateNew(Code, Unicode, Alt, Shift, Control, Press));
end;
function TCocoaConsole.HandleCocoaMouseEvent(theEvent: NSEvent;
const Method: string): Boolean;
begin
Writeln('HandleCocoaMouseEvent ', Method, ' ', theEvent.type_);
Result := False;
end;
function TCocoaConsole.HandleWindowShouldClose(sender: id): Boolean;
begin
Result := False;
if InterceptClose then
FEventQueue.AddEvent(TPTCCloseEventFactory.CreateNew)
else
Halt(0);
end;
procedure TCocoaConsole.HandleEvents;
var
pool: NSAutoreleasePool;
event: NSEvent;
begin
repeat
pool := NSAutoreleasePool.alloc.init;
try
event := NSApp.nextEventMatchingMask_untilDate_inMode_dequeue(NSAnyEventMask,
NSDate.distantPast,
NSDefaultRunLoopMode,
True);
if event <> nil then
begin
NSApp.sendEvent(event);
NSApp.updateWindows;
end;
finally
pool.release;
end;
until event = nil;
end;
constructor TCocoaConsole.Create;
var
s: AnsiString;
begin
inherited Create;
FTitle := '';
FCopy := TPTCCopy.Create;
FClear := TPTCClear.Create;
FPalette := TPTCPalette.Create;
FClip := TPTCArea.Create;
FArea := TPTCArea.Create;
FFormat := TPTCFormat.Create;
FEventQueue := TEventQueue.Create;
Configure('/usr/share/ptcpas/ptcpas.conf');
s := fpgetenv('HOME');
if s = '' then
s := '/';
if s[Length(s)] <> '/' then
s := s + '/';
s := s + '.ptcpas.conf';
Configure(s);
end;
destructor TCocoaConsole.Destroy;
begin
Close;
FCopy.Free;
FClear.Free;
FEventQueue.Free;
inherited Destroy;
end;
procedure TCocoaConsole.Copy(ASurface: IPTCSurface);
begin
end;
procedure TCocoaConsole.Copy(ASurface: IPTCSurface; ASource,
ADestination: IPTCArea);
begin
end;
function TCocoaConsole.Lock: Pointer;
begin
Result := FImageRep.bitmapData;
end;
procedure TCocoaConsole.Unlock;
begin
end;
procedure TCocoaConsole.Load(const APixels: Pointer; AWidth, AHeight,
APitch: Integer; AFormat: IPTCFormat; APalette: IPTCPalette);
var
console_pixels: Pointer;
begin
if Clip.Equals(Area) then
begin
try
console_pixels := Lock;
try
FCopy.Request(AFormat, Format);
FCopy.Palette(APalette, Palette);
FCopy.Copy(APixels, 0, 0, AWidth, AHeight, APitch, console_pixels, 0, 0,
Width, Height, Pitch);
finally
Unlock;
end;
except
on error: TPTCError do
raise TPTCError.Create('failed to load pixels to console', error);
end;
end
else
Load(APixels, AWidth, AHeight, APitch, AFormat, APalette,
TPTCArea.Create(0, 0, width, height), Area);
end;
procedure TCocoaConsole.Load(const APixels: Pointer; AWidth, AHeight,
APitch: Integer; AFormat: IPTCFormat; APalette: IPTCPalette; ASource,
ADestination: IPTCArea);
var
console_pixels: Pointer;
clipped_source, clipped_destination: IPTCArea;
begin
try
console_pixels := Lock;
try
TPTCClipper.Clip(ASource, TPTCArea.Create(0, 0, AWidth, AHeight),
clipped_source,
ADestination, Clip,
clipped_destination);
FCopy.request(AFormat, Format);
FCopy.palette(APalette, Palette);
FCopy.copy(APixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, APitch,
console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, Pitch);
finally
Unlock;
end;
except
on error: TPTCError do
raise TPTCError.Create('failed to load pixels to console area', error);
end;
end;
procedure TCocoaConsole.Save(APixels: Pointer; AWidth, AHeight,
APitch: Integer; AFormat: IPTCFormat; APalette: IPTCPalette);
begin
end;
procedure TCocoaConsole.Save(APixels: Pointer; AWidth, AHeight,
APitch: Integer; AFormat: IPTCFormat; APalette: IPTCPalette; ASource,
ADestination: IPTCArea);
begin
end;
procedure TCocoaConsole.Clear;
begin
end;
procedure TCocoaConsole.Clear(AColor: IPTCColor);
begin
end;
procedure TCocoaConsole.Clear(AColor: IPTCColor; AArea: IPTCArea);
begin
end;
procedure TCocoaConsole.Palette(APalette: IPTCPalette);
begin
end;
procedure TCocoaConsole.Clip(AArea: IPTCArea);
begin
FClip := AArea;
end;
function TCocoaConsole.Option(const AOption: String): Boolean;
begin
LOG('console option', AOption);
Result := True;
case AOption of
'intercept window close': FInterceptClose := True;
'enable logging': LOG_enabled := True;
'disable logging': LOG_enabled := False;
else
Result := FCopy.Option(AOption);
end;
end;
function TCocoaConsole.Clip: IPTCArea;
begin
Result := FClip;
end;
function TCocoaConsole.Palette: IPTCPalette;
begin
Result := FPalette;
end;
procedure TCocoaConsole.Configure(const AFileName: String);
var
F: TextFile;
S: string;
begin
AssignFile(F, AFileName);
{$push}{$I-}
Reset(F);
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$push}{$I-}
Readln(F, S);
{$pop}
if IOResult <> 0 then
Break;
Option(S);
end;
CloseFile(F);
end;
function TCocoaConsole.Modes: TPTCModeList;
begin
Result := nil;
end;
procedure TCocoaConsole.Open(const ATitle: string; APages: Integer);
begin
Open(ATitle, TPTCFormat.Create(32, $FF0000, $FF00, $FF), APages);
end;
procedure TCocoaConsole.Open(const ATitle: string; AFormat: IPTCFormat;
APages: Integer);
begin
Open(ATitle, 640, 480, AFormat, APages);
end;
procedure TCocoaConsole.Open(const ATitle: string; AWidth, AHeight: Integer;
AFormat: IPTCFormat; APages: Integer);
var
rct: NSRect;
pool: NSAutoreleasePool;
begin
LOG('TCocoaConsole.Open');
LOG('width', AWidth);
LOG('height', AHeight);
LOG('format', AFormat);
LOG('pages', APages);
Close;
FTitle := ATitle;
FWidth := AWidth;
FHeight := AHeight;
MaybeCreateAutoreleasePool;
pool := NSAutoreleasePool.alloc.init;
try
NSApplication.sharedApplication;
NSApp.finishLaunching;
rct := NSMakeRect(0, 0, AWidth, AHeight);
FWindowDelegate := NSPTCWindowDelegate.alloc.init;
FWindowDelegate.FConsole := Self;
FWindow := NSPTCWindow.alloc.initWithContentRect_styleMask_backing_defer(rct,
NSTitledWindowMask or NSClosableWindowMask or NSMiniaturizableWindowMask {or NSResizableWindowMask},
NSBackingStoreBuffered,
//NSBackingStoreRetained,
//NSBackingStoreNonretained,
false);
FWindow.FConsole := Self;
FWindow.setDelegate(FWindowDelegate);
FImageRep := NSBitmapImageRep.alloc;
FImageRep := FImageRep.initWithBitmapDataPlanes_pixelsWide_pixelsHigh_bitsPerSample_samplesPerPixel_hasAlpha_isPlanar_colorSpaceName_bytesPerRow_bitsP{erPixel}(
nil,
AWidth,
AHeight,
8,
4,
True,
False,
NSDeviceRGBColorSpace,
0,
32);
{$ifdef FPC_BIG_ENDIAN}
FFormat := TPTCFormat.Create(32, $FF000000, $FF0000, $FF00);
{$else}
FFormat := TPTCFormat.Create(32, $FF, $FF00, $FF0000);
{$endif}
FPitch := FImageRep.bytesPerRow;
FImage := NSImage.alloc.initWithSize(NSMakeSize(AWidth, AHeight));
FImage.addRepresentation(FImageRep);
FView := NSView.alloc.initWithFrame(NSMakeRect(0, 0, AWidth, AHeight));
FWindow.setContentView(FView);
FWindow.setAcceptsMouseMovedEvents(True);
FWindow.center;
FWindow.setTitle(NSWStr(ATitle).autorelease);
FWindow.makeKeyAndOrderFront(NSApp);
FWindow.makeMainWindow;
NSApp.activateIgnoringOtherApps(True);
{ Set clipping area }
FClip := TPTCArea.Create(0, 0, FWidth, FHeight);
finally
pool.release;
end;
end;
procedure TCocoaConsole.Open(const ATitle: string; AMode: IPTCMode;
APages: Integer);
begin
Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages);
end;
procedure TCocoaConsole.Close;
begin
LOG('TCocoaConsole.Close');
if Assigned(FWindow) then
begin
LOG('closing and releasing window');
FWindow.setDelegate(nil);
FWindow.FConsole := nil;
FWindow.close;
FWindow := nil;
end;
if Assigned(FWindowDelegate) then
begin
LOG('releasing window delegate');
FWindowDelegate.FConsole := nil;
FWindowDelegate.release;
FWindowDelegate := nil;
end;
if Assigned(FView) then
begin
LOG('releasing view');
FView.release;
FView := nil;
end;
if Assigned(FImage) then
begin
LOG('releasing image');
FImage.release;
FImage := nil;
end;
if Assigned(FImageRep) then
begin
LOG('releasing image rep');
FImageRep.release;
FImageRep := nil;
end;
LOG('TCocoaConsole.Close done');
end;
procedure TCocoaConsole.Flush;
begin
end;
procedure TCocoaConsole.Finish;
begin
end;
procedure TCocoaConsole.Update;
var
pool: NSAutoreleasePool;
begin
pool := NSAutoreleasePool.alloc.init;
try
FView.lockFocus;
FImage.drawInRect_fromRect_operation_fraction(NSMakeRect(0, 0, FWidth, FHeight), NSZeroRect, NSCompositeCopy, 1.0);
FView.unlockFocus;
FWindow.flushWindow;
finally
pool.release;
end;
HandleEvents;
end;
procedure TCocoaConsole.Update(AArea: IPTCArea);
begin
Update;
end;
function TCocoaConsole.NextEvent(out AEvent: IPTCEvent; AWait: Boolean;
const AEventMask: TPTCEventMask): Boolean;
var
pool: NSAutoreleasePool;
begin
repeat
{ process all events from the Cocoa event queue and put them on our FEventQueue }
HandleEvents;
{ try to find an event that matches the EventMask }
AEvent := FEventQueue.NextEvent(AEventMask);
if AWait and (AEvent = Nil) then
begin
pool := NSAutoreleasePool.alloc.init;
try
{ if the Cocoa event queue is empty, block until an event is received }
NSApp.nextEventMatchingMask_untilDate_inMode_dequeue(NSAnyEventMask,
NSDate.distantFuture,
NSDefaultRunLoopMode,
False);
finally
pool.release;
end;
end;
until (not AWait) or (AEvent <> Nil);
Result := AEvent <> nil;
end;
function TCocoaConsole.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
var
pool: NSAutoreleasePool;
begin
repeat
{ process all events from the Cocoa event queue and put them on our FEventQueue }
HandleEvents;
{ try to find an event that matches the EventMask }
Result := FEventQueue.PeekEvent(AEventMask);
if AWait and (Result = Nil) then
begin
pool := NSAutoreleasePool.alloc.init;
try
{ if the Cocoa event queue is empty, block until an event is received }
NSApp.nextEventMatchingMask_untilDate_inMode_dequeue(NSAnyEventMask,
NSDate.distantFuture,
NSDefaultRunLoopMode,
False);
finally
pool.release;
end;
end;
until (not AWait) or (Result <> nil);
end;

20
packages/ptc/src/core/consolei.inc
View File

@ -1,6 +1,6 @@
{ {
Free Pascal port of the OpenPTC C++ library. Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003, 2006, 2007, 2009-2013 Nikolay Nikolov (nickysn@users.sourceforge.net) Copyright (C) 2001-2003, 2006, 2007, 2009-2013, 2015 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org) Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or This library is free software; you can redistribute it and/or
@ -31,6 +31,7 @@
} }
type type
TPTCBaseConsoleClass = class of TPTCBaseConsole;
TPTCConsole = class(TPTCBaseConsole) TPTCConsole = class(TPTCBaseConsole)
private private
FConsole: IPTCConsole; FConsole: IPTCConsole;
@ -133,12 +134,15 @@ const
{$IFDEF WinCE} {$IFDEF WinCE}
ConsoleTypesNumber = 2; ConsoleTypesNumber = 2;
{$ENDIF WinCE} {$ENDIF WinCE}
{$IFDEF UNIX} {$IFDEF X11}
ConsoleTypesNumber = 1; ConsoleTypesNumber = 1;
{$ENDIF UNIX} {$ENDIF X11}
{$IFDEF COCOA}
ConsoleTypesNumber = 1;
{$ENDIF COCOA}
ConsoleTypes: array [0..ConsoleTypesNumber - 1] of ConsoleTypes: array [0..ConsoleTypesNumber - 1] of
record record
ConsoleClass: class of TPTCBaseConsole; ConsoleClass: TPTCBaseConsoleClass;
Names: array [1..2] of string; Names: array [1..2] of string;
OpenGL: Boolean; OpenGL: Boolean;
end = end =
@ -160,9 +164,13 @@ const
(ConsoleClass: TWinCEGDIConsole; Names: ('GDI', ''); OpenGL: False) (ConsoleClass: TWinCEGDIConsole; Names: ('GDI', ''); OpenGL: False)
{$ENDIF WinCE} {$ENDIF WinCE}
{$IFDEF UNIX} {$IFDEF X11}
(ConsoleClass: TX11Console; Names: ('X11', ''); OpenGL: {$IFDEF ENABLE_X11_EXTENSION_GLX}True{$ELSE}False{$ENDIF}) (ConsoleClass: TX11Console; Names: ('X11', ''); OpenGL: {$IFDEF ENABLE_X11_EXTENSION_GLX}True{$ELSE}False{$ENDIF})
{$ENDIF UNIX} {$ENDIF X11}
{$IFDEF COCOA}
(ConsoleClass: TCocoaConsole; Names: ('COCOA', ''); OpenGL: False)
{$ENDIF COCOA}
); );
constructor TPTCConsole.Create; constructor TPTCConsole.Create;

22
packages/ptc/src/core/keyeventd.inc
View File

@ -1,6 +1,6 @@
{ {
Free Pascal port of the OpenPTC C++ library. Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net) Copyright (C) 2001-2003, 2006, 2007, 2009-2011, 2015 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org) Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or This library is free software; you can redistribute it and/or
@ -31,6 +31,8 @@
} }
type type
TPTCModifierKey = (pmkAlt, pmkShift, pmkControl);
TPTCModifierKeys = set of TPTCModifierKey;
IPTCKeyEvent = interface(IPTCEvent) IPTCKeyEvent = interface(IPTCEvent)
['{9BD1CD41-1DF6-4392-99DC-885EADB6D85A}'] ['{9BD1CD41-1DF6-4392-99DC-885EADB6D85A}']
function GetCode: Integer; function GetCode: Integer;
@ -40,8 +42,7 @@ type
function GetControl: Boolean; function GetControl: Boolean;
function GetPress: Boolean; function GetPress: Boolean;
function GetRelease: Boolean; function GetRelease: Boolean;
function GetModifierKeys: TPTCModifierKeys;
// function Equals(AKey: IPTCKeyEvent): Boolean;
property Code: Integer read GetCode; property Code: Integer read GetCode;
property Unicode: Integer read GetUnicode; property Unicode: Integer read GetUnicode;
@ -50,6 +51,7 @@ type
property Control: Boolean read GetControl; property Control: Boolean read GetControl;
property Press: Boolean read GetPress; property Press: Boolean read GetPress;
property Release: Boolean read GetRelease; property Release: Boolean read GetRelease;
property ModifierKeys: TPTCModifierKeys read GetModifierKeys;
end; end;
TPTCKeyEventFactory = class TPTCKeyEventFactory = class
@ -58,12 +60,18 @@ type
class function CreateNew(ACode: Integer): IPTCKeyEvent; class function CreateNew(ACode: Integer): IPTCKeyEvent;
class function CreateNew(ACode, AUnicode: Integer): IPTCKeyEvent; class function CreateNew(ACode, AUnicode: Integer): IPTCKeyEvent;
class function CreateNew(ACode, AUnicode: Integer; APress: Boolean): IPTCKeyEvent; class function CreateNew(ACode, AUnicode: Integer; APress: Boolean): IPTCKeyEvent;
class function CreateNew(ACode: Integer; AAlt, AShift, AControl: Boolean): IPTCKeyEvent; class function CreateNew(ACode: Integer; AAlt, AShift, AControl: Boolean): IPTCKeyEvent; deprecated;
class function CreateNew(ACode: Integer; AAlt, AShift, AControl, APress: Boolean): IPTCKeyEvent; class function CreateNew(ACode: Integer; AAlt, AShift, AControl, APress: Boolean): IPTCKeyEvent; deprecated;
class function CreateNew(ACode, AUnicode: Integer; class function CreateNew(ACode, AUnicode: Integer;
AAlt, AShift, AControl: Boolean): IPTCKeyEvent; AAlt, AShift, AControl: Boolean): IPTCKeyEvent; deprecated;
class function CreateNew(ACode, AUnicode: Integer; class function CreateNew(ACode, AUnicode: Integer;
AAlt, AShift, AControl, APress: Boolean): IPTCKeyEvent; AAlt, AShift, AControl, APress: Boolean): IPTCKeyEvent; deprecated;
class function CreateNew(ACode: Integer; const AModifierKeys: TPTCModifierKeys): IPTCKeyEvent;
class function CreateNew(ACode: Integer; const AModifierKeys: TPTCModifierKeys; APress: Boolean): IPTCKeyEvent;
class function CreateNew(ACode, AUnicode: Integer;
const AModifierKeys: TPTCModifierKeys): IPTCKeyEvent;
class function CreateNew(ACode, AUnicode: Integer;
const AModifierKeys: TPTCModifierKeys; APress: Boolean): IPTCKeyEvent;
class function CreateNew(AKey: IPTCKeyEvent): IPTCKeyEvent; class function CreateNew(AKey: IPTCKeyEvent): IPTCKeyEvent;
end; end;

183
packages/ptc/src/core/keyeventi.inc
View File

@ -1,6 +1,6 @@
{ {
Free Pascal port of the OpenPTC C++ library. Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net) Copyright (C) 2001-2003, 2006, 2007, 2009-2011, 2015 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org) Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or This library is free software; you can redistribute it and/or
@ -34,9 +34,7 @@ type
private private
FCode: Integer; FCode: Integer;
FUnicode: Integer; FUnicode: Integer;
FAlt: Boolean; FModifierKeys: TPTCModifierKeys;
FShift: Boolean;
FControl: Boolean;
FPress: Boolean; FPress: Boolean;
function GetCode: Integer; function GetCode: Integer;
@ -46,6 +44,7 @@ type
function GetControl: Boolean; function GetControl: Boolean;
function GetPress: Boolean; function GetPress: Boolean;
function GetRelease: Boolean; function GetRelease: Boolean;
function GetModifierKeys: TPTCModifierKeys;
protected protected
function GetEventType: TPTCEventType; override; function GetEventType: TPTCEventType; override;
public public
@ -53,22 +52,19 @@ type
constructor Create(ACode: Integer); constructor Create(ACode: Integer);
constructor Create(ACode, AUnicode: Integer); constructor Create(ACode, AUnicode: Integer);
constructor Create(ACode, AUnicode: Integer; APress: Boolean); constructor Create(ACode, AUnicode: Integer; APress: Boolean);
constructor Create(ACode: Integer; AAlt, AShift, AControl: Boolean); constructor Create(ACode: Integer; AAlt, AShift, AControl: Boolean); deprecated;
constructor Create(ACode: Integer; AAlt, AShift, AControl, APress: Boolean); constructor Create(ACode: Integer; AAlt, AShift, AControl, APress: Boolean); deprecated;
constructor Create(ACode, AUnicode: Integer; constructor Create(ACode, AUnicode: Integer;
AAlt, AShift, AControl: Boolean); AAlt, AShift, AControl: Boolean); deprecated;
constructor Create(ACode, AUnicode: Integer; constructor Create(ACode, AUnicode: Integer;
AAlt, AShift, AControl, APress: Boolean); AAlt, AShift, AControl, APress: Boolean); deprecated;
constructor Create(ACode: Integer; const AModifierKeys: TPTCModifierKeys);
constructor Create(ACode: Integer; const AModifierKeys: TPTCModifierKeys; APress: Boolean);
constructor Create(ACode, AUnicode: Integer;
const AModifierKeys: TPTCModifierKeys);
constructor Create(ACode, AUnicode: Integer;
const AModifierKeys: TPTCModifierKeys; APress: Boolean);
constructor Create(AKey: IPTCKeyEvent); constructor Create(AKey: IPTCKeyEvent);
{ procedure Assign(const AKey: TPTCKeyEvent);
function Equals(const AKey: TPTCKeyEvent): Boolean;
property Code: Integer read GetCode;
property Unicode: Integer read GetUnicode;
property Alt: Boolean read GetAlt;
property Shift: Boolean read GetShift;
property Control: Boolean read GetControl;
property Press: Boolean read GetPress;
property Release: Boolean read GetRelease;}
end; end;
class function TPTCKeyEventFactory.CreateNew: IPTCKeyEvent; class function TPTCKeyEventFactory.CreateNew: IPTCKeyEvent;
@ -113,6 +109,28 @@ begin
Result := TPTCKeyEvent.Create(ACode, AUnicode, AAlt, AShift, AControl, APress); Result := TPTCKeyEvent.Create(ACode, AUnicode, AAlt, AShift, AControl, APress);
end; end;
class function TPTCKeyEventFactory.CreateNew(ACode: Integer; const AModifierKeys: TPTCModifierKeys): IPTCKeyEvent;
begin
Result := TPTCKeyEvent.Create(ACode, AModifierKeys);
end;
class function TPTCKeyEventFactory.CreateNew(ACode: Integer; const AModifierKeys: TPTCModifierKeys; APress: Boolean): IPTCKeyEvent;
begin
Result := TPTCKeyEvent.Create(ACode, AModifierKeys, APress);
end;
class function TPTCKeyEventFactory.CreateNew(ACode, AUnicode: Integer;
const AModifierKeys: TPTCModifierKeys): IPTCKeyEvent;
begin
Result := TPTCKeyEvent.Create(ACode, AUnicode, AModifierKeys);
end;
class function TPTCKeyEventFactory.CreateNew(ACode, AUnicode: Integer;
const AModifierKeys: TPTCModifierKeys; APress: Boolean): IPTCKeyEvent;
begin
Result := TPTCKeyEvent.Create(ACode, AUnicode, AModifierKeys, APress);
end;
class function TPTCKeyEventFactory.CreateNew(AKey: IPTCKeyEvent): IPTCKeyEvent; class function TPTCKeyEventFactory.CreateNew(AKey: IPTCKeyEvent): IPTCKeyEvent;
begin begin
Result := TPTCKeyEvent.Create(AKey); Result := TPTCKeyEvent.Create(AKey);
@ -127,9 +145,7 @@ constructor TPTCKeyEvent.Create;
begin begin
FCode := Integer(PTCKEY_UNDEFINED); FCode := Integer(PTCKEY_UNDEFINED);
FUnicode := -1; FUnicode := -1;
FAlt := False; FModifierKeys := [];
FShift := False;
FControl := False;
FPress := True; FPress := True;
end; end;
@ -137,9 +153,7 @@ constructor TPTCKeyEvent.Create(ACode: Integer);
begin begin
FCode := ACode; FCode := ACode;
FUnicode := -1; FUnicode := -1;
FAlt := False; FModifierKeys := [];
FShift := False;
FControl := False;
FPress := True; FPress := True;
end; end;
@ -147,9 +161,7 @@ constructor TPTCKeyEvent.Create(ACode, AUnicode: Integer);
begin begin
FCode := ACode; FCode := ACode;
FUnicode := AUnicode; FUnicode := AUnicode;
FAlt := False; FModifierKeys := [];
FShift := False;
FControl := False;
FPress := True; FPress := True;
end; end;
@ -157,9 +169,7 @@ constructor TPTCKeyEvent.Create(ACode, AUnicode: Integer; APress: Boolean);
begin begin
FCode := ACode; FCode := ACode;
FUnicode := AUnicode; FUnicode := AUnicode;
FAlt := False; FModifierKeys := [];
FShift := False;
FControl := False;
FPress := APress; FPress := APress;
end; end;
@ -167,9 +177,13 @@ constructor TPTCKeyEvent.Create(ACode: Integer; AAlt, AShift, AControl: Boolean)
begin begin
FCode := ACode; FCode := ACode;
FUnicode := -1; FUnicode := -1;
FAlt := AAlt; FModifierKeys := [];
FShift := AShift; if AAlt then
FControl := AControl; Include(FModifierKeys, pmkAlt);
if AShift then
Include(FModifierKeys, pmkShift);
if AControl then
Include(FModifierKeys, pmkControl);
FPress := True; FPress := True;
end; end;
@ -177,9 +191,13 @@ constructor TPTCKeyEvent.Create(ACode: Integer; AAlt, AShift, AControl, APress:
begin begin
FCode := ACode; FCode := ACode;
FUnicode := -1; FUnicode := -1;
FAlt := AAlt; FModifierKeys := [];
FShift := AShift; if AAlt then
FControl := AControl; Include(FModifierKeys, pmkAlt);
if AShift then
Include(FModifierKeys, pmkShift);
if AControl then
Include(FModifierKeys, pmkControl);
FPress := APress; FPress := APress;
end; end;
@ -187,9 +205,13 @@ constructor TPTCKeyEvent.Create(ACode, AUnicode: Integer; AAlt, AShift, AControl
begin begin
FCode := ACode; FCode := ACode;
FUnicode := AUnicode; FUnicode := AUnicode;
FAlt := AAlt; FModifierKeys := [];
FShift := AShift; if AAlt then
FControl := AControl; Include(FModifierKeys, pmkAlt);
if AShift then
Include(FModifierKeys, pmkShift);
if AControl then
Include(FModifierKeys, pmkControl);
FPress := True; FPress := True;
end; end;
@ -198,42 +220,58 @@ constructor TPTCKeyEvent.Create(ACode, AUnicode: Integer;
begin begin
FCode := ACode; FCode := ACode;
FUnicode := AUnicode; FUnicode := AUnicode;
FAlt := AAlt; FModifierKeys := [];
FShift := AShift; if AAlt then
FControl := AControl; Include(FModifierKeys, pmkAlt);
if AShift then
Include(FModifierKeys, pmkShift);
if AControl then
Include(FModifierKeys, pmkControl);
FPress := APress; FPress := APress;
end; end;
constructor TPTCKeyEvent.Create(ACode: Integer; const AModifierKeys: TPTCModifierKeys);
begin
FCode := ACode;
FUnicode := -1;
FModifierKeys := AModifierKeys;
FPress := True;
end;
constructor TPTCKeyEvent.Create(ACode: Integer; const AModifierKeys: TPTCModifierKeys; APress: Boolean);
begin
FCode := ACode;
FUnicode := -1;
FModifierKeys := AModifierKeys;
FPress := APress;
end;
constructor TPTCKeyEvent.Create(ACode, AUnicode: Integer;
const AModifierKeys: TPTCModifierKeys);
begin
FCode := ACode;
FUnicode := AUnicode;
FModifierKeys := AModifierKeys;
FPress := True;
end;
constructor TPTCKeyEvent.Create(ACode, AUnicode: Integer;
const AModifierKeys: TPTCModifierKeys; APress: Boolean);
begin
FCode := ACode;
FUnicode := AUnicode;
FModifierKeys := AModifierKeys;
FPress := APress;
end;
constructor TPTCKeyEvent.Create(AKey: IPTCKeyEvent); constructor TPTCKeyEvent.Create(AKey: IPTCKeyEvent);
begin begin
FCode := AKey.Code; FCode := AKey.Code;
FUnicode := AKey.Unicode; FUnicode := AKey.Unicode;
FAlt := AKey.Alt; FModifierKeys := AKey.ModifierKeys;
FShift := AKey.Shift; FPress := AKey.Press;
FControl := AKey.Control;
FPress := AKey.Press;
end; end;
{procedure TPTCKeyEvent.Assign(const AKey: TPTCKeyEvent);
begin
FCode := AKey.Code;
FUnicode := AKey.Unicode;
FAlt := AKey.Alt;
FShift := AKey.Shift;
FControl := AKey.Control;
FPress := AKey.Press;
end;
function TPTCKeyEvent.Equals(const AKey: TPTCKeyEvent): Boolean;
begin
Result := (FCode = AKey.FCode) and
(FUnicode = AKey.FUnicode) and
(FAlt = AKey.FAlt) and
(FShift = AKey.FShift) and
(FControl = AKey.FControl) and
(FPress = AKey.FPress);
end;}
function TPTCKeyEvent.GetCode: Integer; function TPTCKeyEvent.GetCode: Integer;
begin begin
Result := FCode; Result := FCode;
@ -246,17 +284,17 @@ end;
function TPTCKeyEvent.GetAlt: Boolean; function TPTCKeyEvent.GetAlt: Boolean;
begin begin
Result := FAlt; Result := pmkAlt in FModifierKeys;
end; end;
function TPTCKeyEvent.GetShift: Boolean; function TPTCKeyEvent.GetShift: Boolean;
begin begin
Result := FShift; Result := pmkShift in FModifierKeys;
end; end;
function TPTCKeyEvent.GetControl: Boolean; function TPTCKeyEvent.GetControl: Boolean;
begin begin
Result := FControl; Result := pmkControl in FModifierKeys;
end; end;
function TPTCKeyEvent.GetPress: Boolean; function TPTCKeyEvent.GetPress: Boolean;
@ -268,3 +306,8 @@ function TPTCKeyEvent.GetRelease: Boolean;
begin begin
Result := not FPress; Result := not FPress;
end; end;
function TPTCKeyEvent.GetModifierKeys: TPTCModifierKeys;
begin
Result := FModifierKeys;
end;

62
packages/ptc/src/ptc.pp
View File

@ -1,6 +1,6 @@
{ {
Free Pascal port of the OpenPTC C++ library. Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net) Copyright (C) 2001-2007, 2009-2012, 2015 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org) Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or This library is free software; you can redistribute it and/or
@ -37,6 +37,15 @@
{$H+} {$H+}
{$IFDEF UNIX} {$IFDEF UNIX}
{$IF defined(DARWIN)}
{$DEFINE COCOA}
{$MODESWITCH objectivec1}
{$ELSE}
{$DEFINE X11}
{$ENDIF}
{$ENDIF UNIX}
{$IFDEF X11}
{ X11 extensions we want to enable at compile time } { X11 extensions we want to enable at compile time }
{$INCLUDE x11/x11extensions.inc} {$INCLUDE x11/x11extensions.inc}
@ -48,7 +57,7 @@
{$DEFINE ENABLE_X11_EXTENSION_XF86DGA} {$DEFINE ENABLE_X11_EXTENSION_XF86DGA}
{$ENDIF ENABLE_X11_EXTENSION_XF86DGA2} {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2}
{$ENDIF UNIX} {$ENDIF X11}
unit ptc; unit ptc;
@ -60,7 +69,7 @@ uses
{$ENDIF FPDOC} {$ENDIF FPDOC}
const const
PTCPAS_VERSION = 'PTCPas 0.99.14'; PTCPAS_VERSION = 'PTCPas 0.99.14.1';
type type
PUint8 = ^Uint8; PUint8 = ^Uint8;
@ -123,22 +132,28 @@ uses
{$IFDEF UNIX} {$IFDEF UNIX}
uses uses
BaseUnix, Unix, ctypes, x, xlib, xutil, xatom, keysym, xkblib BaseUnix, Unix
{$IFDEF ENABLE_X11_EXTENSION_XRANDR} {$IFDEF X11}
, xrandr , ctypes, x, xlib, xutil, xatom, keysym, xkblib
{$ENDIF ENABLE_X11_EXTENSION_XRANDR} {$IFDEF ENABLE_X11_EXTENSION_XRANDR}
{$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE} , xrandr
, xf86vmode {$ENDIF ENABLE_X11_EXTENSION_XRANDR}
{$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE} {$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE}
{$IFDEF ENABLE_X11_EXTENSION_XF86DGA} , xf86vmode
, xf86dga {$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE}
{$ENDIF ENABLE_X11_EXTENSION_XF86DGA} {$IFDEF ENABLE_X11_EXTENSION_XF86DGA}
{$IFDEF ENABLE_X11_EXTENSION_XSHM} , xf86dga
, xshm, ipc {$ENDIF ENABLE_X11_EXTENSION_XF86DGA}
{$ENDIF ENABLE_X11_EXTENSION_XSHM} {$IFDEF ENABLE_X11_EXTENSION_XSHM}
{$IFDEF ENABLE_X11_EXTENSION_GLX} , xshm, ipc
, glx {$ENDIF ENABLE_X11_EXTENSION_XSHM}
{$ENDIF ENABLE_X11_EXTENSION_GLX} {$IFDEF ENABLE_X11_EXTENSION_GLX}
, glx
{$ENDIF ENABLE_X11_EXTENSION_GLX}
{$ENDIF X11}
{$IFDEF COCOA}
, CocoaAll
{$ENDIF COCOA}
; ;
{$ENDIF UNIX} {$ENDIF UNIX}
@ -233,9 +248,14 @@ end;
{$INCLUDE wince/includes.inc} {$INCLUDE wince/includes.inc}
{$ENDIF WinCE} {$ENDIF WinCE}
{$IFDEF UNIX} {$IFDEF X11}
{$INCLUDE x11/x11includes.inc} {$INCLUDE x11/x11includes.inc}
{$ENDIF UNIX} {$ENDIF X11}
{$IFDEF COCOA}
{$INCLUDE cocoa/cocoaconsoled.inc}
{$INCLUDE cocoa/cocoaconsolei.inc}
{$ENDIF COCOA}
{$INCLUDE core/consolei.inc} {$INCLUDE core/consolei.inc}

18
packages/ptc/src/x11/x11displayi.inc
View File

@ -448,7 +448,7 @@ var
sym: TKeySym; sym: TKeySym;
sym_modded: TKeySym; { modifiers like shift are taken into account here } sym_modded: TKeySym; { modifiers like shift are taken into account here }
press: Boolean; press: Boolean;
alt, shift, ctrl: Boolean; modkeys: TPTCModifierKeys;
uni: Integer; uni: Integer;
key: TPTCKeyEvent; key: TPTCKeyEvent;
buf: array [1..16] of Char; buf: array [1..16] of Char;
@ -457,9 +457,13 @@ begin
XLookupString(@e, @buf, SizeOf(buf), @sym_modded, nil); XLookupString(@e, @buf, SizeOf(buf), @sym_modded, nil);
// Writeln('sym_modded = ', sym_modded); // Writeln('sym_modded = ', sym_modded);
uni := X11ConvertKeySymToUnicode(sym_modded); uni := X11ConvertKeySymToUnicode(sym_modded);
alt := (e.state and Mod1Mask) <> 0; modkeys := [];
shift := (e.state and ShiftMask) <> 0; if (e.state and Mod1Mask) <> 0 then
ctrl := (e.state and ControlMask) <> 0; Include(modkeys, pmkAlt);
if (e.state and ShiftMask) <> 0 then
Include(modkeys, pmkShift);
if (e.state and ControlMask) <> 0 then
Include(modkeys, pmkControl);
if e._type = KeyPress then if e._type = KeyPress then
press := True press := True
else else
@ -470,7 +474,7 @@ begin
begin begin
sym_modded := XK_Tab; sym_modded := XK_Tab;
uni := 9; uni := 9;
shift := True; Include(modkeys, pmkShift);
end; end;
// Hack, used for handling the code of Shift-Key combinations // Hack, used for handling the code of Shift-Key combinations
@ -489,8 +493,8 @@ begin
key := nil; key := nil;
case sym_modded shr 8 of case sym_modded shr 8 of
0: key := TPTCKeyEvent.Create(FNormalKeys[sym_modded and $FF], uni, alt, shift, ctrl, press); 0: key := TPTCKeyEvent.Create(FNormalKeys[sym_modded and $FF], uni, modkeys, press);
$FF: key := TPTCKeyEvent.Create(FFunctionKeys[sym_modded and $FF], uni, alt, shift, ctrl, press); $FF: key := TPTCKeyEvent.Create(FFunctionKeys[sym_modded and $FF], uni, modkeys, press);
else else
key := TPTCKeyEvent.Create; key := TPTCKeyEvent.Create;
end; end;

4
packages/ptc/src/x11/x11windowdisplayi.inc
View File

@ -520,9 +520,9 @@ var
else else
PTCMouseButtonState := [PTCMouseButton1]; PTCMouseButtonState := [PTCMouseButton1];
if (state and Button2Mask) <> 0 then if (state and Button2Mask) <> 0 then
PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2];
if (state and Button3Mask) <> 0 then
PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3]; PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3];
if (state and Button3Mask) <> 0 then
PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2];
if (state and Button4Mask) <> 0 then if (state and Button4Mask) <> 0 then
PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton4]; PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton4];
if (state and Button5Mask) <> 0 then if (state and Button5Mask) <> 0 then