paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 11:48:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* updated ptcpas to 0.99.13

Browse Source 
git-svn-id: trunk@23005 -
This commit is contained in:
nickysn 2012-11-17 19:03:53 +00:00
parent 504b2bc544
commit e616d0b7f0
132 changed files with 2767 additions and 363 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
.gitattributes vendored
View File

@ -6021,6 +6021,7 @@ packages/ptc/examples/image.pp svneol=native#text/plain
packages/ptc/examples/image.tga -text
packages/ptc/examples/keyboard.pp svneol=native#text/plain
packages/ptc/examples/keyboard2.pp svneol=native#text/plain
packages/ptc/examples/keyboard3.pp svneol=native#text/plain
packages/ptc/examples/land.pp svneol=native#text/plain
packages/ptc/examples/lights.pp svneol=native#text/plain
packages/ptc/examples/modes.pp svneol=native#text/plain
@ -6029,6 +6030,8 @@ packages/ptc/examples/mojo.raw -text svneol=unset#raw/binary
packages/ptc/examples/mouse.pp svneol=native#text/plain
packages/ptc/examples/palette.pp svneol=native#text/plain
packages/ptc/examples/pixel.pp svneol=native#text/plain
packages/ptc/examples/ptcgl.pp svneol=native#text/plain
packages/ptc/examples/ptcgl2.pp svneol=native#text/plain
packages/ptc/examples/random.pp svneol=native#text/plain
packages/ptc/examples/save.pp svneol=native#text/plain
packages/ptc/examples/stretch.pp svneol=native#text/plain
@ -6099,6 +6102,8 @@ packages/ptc/src/core/moded.inc svneol=native#text/plain
packages/ptc/src/core/modei.inc svneol=native#text/plain
packages/ptc/src/core/mouseeventd.inc svneol=native#text/plain
packages/ptc/src/core/mouseeventi.inc svneol=native#text/plain
packages/ptc/src/core/openglattributesd.inc svneol=native#text/plain
packages/ptc/src/core/openglattributesi.inc svneol=native#text/plain
packages/ptc/src/core/paletted.inc svneol=native#text/plain
packages/ptc/src/core/palettei.inc svneol=native#text/plain
packages/ptc/src/core/surfaced.inc svneol=native#text/plain
@ -6163,8 +6168,14 @@ packages/ptc/src/win32/directx/primaryd.inc svneol=native#text/plain
packages/ptc/src/win32/directx/translate.inc svneol=native#text/plain
packages/ptc/src/win32/gdi/gdiconsoled.inc svneol=native#text/plain
packages/ptc/src/win32/gdi/gdiconsolei.inc svneol=native#text/plain
packages/ptc/src/win32/gdi/gdihookd.inc svneol=native#text/plain
packages/ptc/src/win32/gdi/gdihooki.inc svneol=native#text/plain
packages/ptc/src/win32/gdi/win32dibd.inc svneol=native#text/plain
packages/ptc/src/win32/gdi/win32dibi.inc svneol=native#text/plain
packages/ptc/src/win32/gdi/win32modesetterd.inc svneol=native#text/plain
packages/ptc/src/win32/gdi/win32modesetteri.inc svneol=native#text/plain
packages/ptc/src/win32/gdi/win32openglwindowd.inc svneol=native#text/plain
packages/ptc/src/win32/gdi/win32openglwindowi.inc svneol=native#text/plain
packages/ptc/src/wince/base/wincekeyboardd.inc svneol=native#text/plain
packages/ptc/src/wince/base/wincekeyboardi.inc svneol=native#text/plain
packages/ptc/src/wince/base/wincemoused.inc svneol=native#text/plain
@ -6182,6 +6193,8 @@ packages/ptc/src/wince/gdi/wincegdiconsolei.inc svneol=native#text/plain
packages/ptc/src/wince/includes.inc svneol=native#text/plain
packages/ptc/src/x11/check.inc svneol=native#text/plain
packages/ptc/src/x11/extensions.inc svneol=native#text/plain
packages/ptc/src/x11/glxfbconfigd.inc svneol=native#text/plain
packages/ptc/src/x11/glxfbconfigi.inc svneol=native#text/plain
packages/ptc/src/x11/includes.inc svneol=native#text/plain
packages/ptc/src/x11/x11consoled.inc svneol=native#text/plain
packages/ptc/src/x11/x11consolei.inc svneol=native#text/plain

2
packages/graph/src/ptcgraph/ptccrt.pp
View File

@ -1,6 +1,6 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2010 by Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (c) 2010, 2011 by Nikolay Nikolov (nickysn@users.sourceforge.net)
This file implements keyboard input support for ptcgraph

2
packages/graph/src/ptcgraph/ptcgraph.pp
View File

@ -1,6 +1,6 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2010 by Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (c) 2010, 2011 by Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (c) 2007 by Daniel Mantione
member of the Free Pascal development team

6
packages/ptc/Makefile.fpc.fpcmake
View File

@ -24,8 +24,10 @@ sourcedir=src src/ptcwrapper
[require]
packages=hermes fcl-base
packages_linux=x11
packages_freebsd=x11
packages_linux=x11 opengl
packages_freebsd=x11 opengl
packages_win32=opengl
packages_win64=opengl
[default]
fpcdir=../..

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

@ -1,3 +1,13 @@
0.99.13
- added support for OpenGL under X11 and Windows. You can now use PTCPas to initialize
OpenGL and handle events for you in a multiplatform way (similar to GLUT or SDL). See
ptcgl.pp and ptcgl2.pp in the example directory.
- X11 keyboard handling improvements:
- added support for the numpad keys
- typematic repeat (i.e. when you press a key and hold it down) now sends only
repeating key press events, instead of repeating pairs of key release + key press.
This makes it possible to detect auto-repeat and is also the way that Windows behaves.
0.99.12
- pressing Alt or F10 under Windows no longer pauses the application.
- API changes:

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

@ -1,4 +1,4 @@
PTCPas 0.99.12
PTCPas 0.99.13
Nikolay Nikolov (nickysn@users.sourceforge.net)
PTCPas is a free, portable framebuffer library, written in Free Pascal. It is
@ -10,8 +10,9 @@ The latest version can be found at http://ptcpas.sourceforge.net
Basically it provides an abstraction layer for high-speed low-level graphics
access. It is OOP and supports multiple platforms. (tested on Linux, DOS and
Windows, more will be added in the future)
3d acceleration isn't supported, nor planned. If you need that, you should use
something like OpenGL instead. :-)
Since version 0.99.13 it is also possible to create OpenGL applications with
PTCPas. See the ptcgl.pp and ptcgl2.pp examples in the 'examples' directory.
PTCPas initially started out as a complete Object Pascal translation of the
OpenPTC C++ library. Since then, OpenPTC development has stalled and PTCPas

1
packages/ptc/docs/TODO.txt
View File

@ -3,7 +3,6 @@
- mouse support for the x11 dga console
- key release events support in dos
- multiple video pages support for the x11 w/dga console
- cross-platform opengl initialization support (like sdl or glut)
- make hermes thread safe
- better timing under dos
- delphi (kylix? c++?) bindings

7
packages/ptc/examples/Makefile.fpc
View File

@ -8,9 +8,12 @@ version=2.7.1
[target]
programs=area buffer clear clip con_info console fire \
flower hicolor image keyboard keyboard2 land \
lights modes mojo palette pixel random save \
flower hicolor image keyboard keyboard2 keyboard3 \
land lights modes mojo palette pixel random save \
stretch texwarp timer tunnel3d tunnel
programs_win32=ptcgl ptcgl2
programs_win64=ptcgl ptcgl2
programs_linux=ptcgl ptcgl2
[compiler]
unitdir=../$(UNITTARGETDIRPREFIX)

70
packages/ptc/examples/keyboard3.pp Normal file
View File

@ -0,0 +1,70 @@
{
Keyboard example for the PTCPas library
This source code is in the public domain
}
program KeyboardExample3;
{$MODE objfpc}
uses
ptc;
procedure DumpKey(AKey: IPTCKeyEvent);
begin
Writeln('Code=', AKey.Code:3, ', Unicode=$', HexStr(AKey.Unicode, 4),
', Press=', AKey.Press:5, ', Shift=', AKey.Shift:5, ', Alt=', AKey.Alt:5,
', Control=', AKey.Control:5);
end;
var
console: IPTCConsole;
format: IPTCFormat;
key: IPTCKeyEvent;
Done: Boolean;
begin
try
try
{ create console }
console := TPTCConsoleFactory.CreateNew;
{ enable key release events }
console.KeyReleaseEnabled := True;
{ create format }
format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
{ open the console }
console.open('Keyboard example 3', format);
{ main loop }
Done := False;
repeat
{ check for key press/release }
while console.KeyPressed do
begin
console.ReadKey(key);
case key.code of
PTCKEY_ESCAPE:
begin
Done := True;
Break;
end;
else
DumpKey(key);
end;
end;
{ update console }
console.update;
until Done;
finally
if Assigned(console) then
console.close;
end;
except
on error: TPTCError do
{ report error }
error.report;
end;
end.

81
packages/ptc/examples/ptcgl.pp Normal file
View File

@ -0,0 +1,81 @@
{
PTC OpenGL example for PTCPas
Copyright (c) Nikolay Nikolov (nickysn@users.sourceforge.net)
This source code is in the public domain
}
program PtcGLExample;
{$MODE objfpc}
uses
ptc, gl, SysUtils;
var
Console: IPTCConsole;
Event: IPTCEvent;
Done: Boolean = False;
begin
try
try
{ create console }
Console := TPTCConsoleFactory.CreateNew;
{ tell PTC we want OpenGL }
Console.OpenGL_Enabled := True;
{ enable OpenGL double buffering }
Console.OpenGL_Attributes.DoubleBuffer := True;
{ open the console }
Console.Open('PTC OpenGL example');
glClearColor(0.0, 0.0, 0.0, 0.0);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glOrtho(0.0, 1.0, 0.0, 1.0, -1.0, 1.0);
{ loop until the key 'q' is pressed }
repeat
{ draw scene }
glClear(GL_COLOR_BUFFER_BIT);
glBegin(GL_POLYGON);
glColor3f(1.0, 0.0, 0.0);
glVertex3f(0.25, 0.25, 0.0);
glColor3f(1.0, 1.0, 0.0);
glVertex3f(0.75, 0.25, 0.0);
glColor3f(0.5, 0.0, 1.0);
glVertex3f(0.75, 0.75, 0.0);
glColor3f(0.0, 1.0, 0.0);
glVertex3f(0.25, 0.75, 0.0);
glEnd;
glFlush;
{ swap buffers }
Console.OpenGL_SwapBuffers;
{ check for events }
if Console.NextEvent(Event, False, PTCAnyEvent) then
begin
{ handle keyboard events }
if Supports(event, IPTCKeyEvent) and (event as IPTCKeyEvent).Press then
begin
case (event as IPTCKeyEvent).Code of
PTCKEY_Q: Done := True;
end;
end;
end;
until Done;
finally
if Assigned(Console) then
Console.Close;
end;
except
on Error: TPTCError do
{ report error }
Error.Report;
end;
end.

78
packages/ptc/examples/ptcgl2.pp Normal file
View File

@ -0,0 +1,78 @@
{
PTC OpenGL example for PTCPas
Copyright (c) Nikolay Nikolov (nickysn@users.sourceforge.net)
This source code is in the public domain
}
program PtcGL2Example;
{$MODE objfpc}
uses
ptc, gl, SysUtils;
var
Console: IPTCConsole;
Event: IPTCEvent;
Done: Boolean = False;
begin
try
try
{ create console }
Console := TPTCConsoleFactory.CreateNew;
{ tell PTC we want OpenGL }
Console.OpenGL_Enabled := True;
{ use OpenGL single buffering }
Console.OpenGL_Attributes.DoubleBuffer := False;
{ open the console }
Console.Open('PTC OpenGL single buffering example');
glClearColor(0.0, 0.0, 0.0, 0.0);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glOrtho(0.0, 1.0, 0.0, 1.0, -1.0, 1.0);
{ loop until the key 'q' is pressed }
repeat
{ draw scene }
glClear(GL_COLOR_BUFFER_BIT);
glBegin(GL_POLYGON);
glColor3f(1.0, 0.0, 0.0);
glVertex3f(0.25, 0.25, 0.0);
glColor3f(1.0, 1.0, 0.0);
glVertex3f(0.75, 0.25, 0.0);
glColor3f(0.5, 0.0, 1.0);
glVertex3f(0.75, 0.75, 0.0);
glColor3f(0.0, 1.0, 0.0);
glVertex3f(0.25, 0.75, 0.0);
glEnd;
glFlush;
{ check for events }
if Console.NextEvent(Event, False, PTCAnyEvent) then
begin
{ handle keyboard events }
if Supports(event, IPTCKeyEvent) and (event as IPTCKeyEvent).Press then
begin
case (event as IPTCKeyEvent).Code of
PTCKEY_Q: Done := True;
end;
end;
end;
until Done;
finally
if Assigned(Console) then
Console.Close;
end;
except
on Error: TPTCError do
{ report error }
Error.Report;
end;
end.

10
packages/ptc/fpmake.pp
View File

@ -2,8 +2,6 @@
{$mode objfpc}{$H+}
program fpmake;
// Note this package is currently not compiled and a mess.
uses fpmkunit;
Var
@ -46,6 +44,7 @@ begin
P.Dependencies.Add('hermes');
P.Dependencies.Add('x11',AllUnixOSes);
P.Dependencies.Add('opengl',AllUnixOSes + [win32, win64]);
P.Dependencies.Add('fcl-base');
T:=P.Targets.AddUnit('p_ddraw.pp', [win32, win64]);
@ -89,6 +88,8 @@ begin
AddInclude('baseconsolei.inc');
AddInclude('surfacei.inc');
AddInclude('timeri.inc');
AddInclude('openglattributesd.inc');
AddInclude('openglattributesi.inc');
AddInclude('includes.inc',allunixoses+[WinCE]);
AddInclude('extensions.inc',allunixoses);
AddInclude('x11modesd.inc',allunixoses);
@ -107,6 +108,8 @@ begin
AddInclude('x11dga1displayi.inc',allunixoses);
AddInclude('x11dga2displayi.inc',allunixoses);
AddInclude('x11consolei.inc',allunixoses);
AddInclude('glxfbconfigd.inc',allunixoses);
AddInclude('glxfbconfigi.inc',allunixoses);
AddInclude('consolei.inc');
AddUnit('p_gx',[Wince]);
AddUnit('textfx2',[Go32v2]);
@ -149,10 +152,13 @@ begin
P.Targets.AddExampleProgram('mojo.pp');
P.Targets.AddExampleProgram('land.pp');
P.Targets.AddExampleProgram('keyboard2.pp');
P.Targets.AddExampleProgram('keyboard3.pp');
P.Targets.AddExampleProgram('clear.pp');
P.Targets.AddExampleProgram('con_info.pp');
P.Targets.AddExampleProgram('area.pp');
P.Targets.AddExampleProgram('tunnel3d.pp');
P.Targets.AddExampleProgram('ptcgl.pp', AllUnixOSes + [win32, win64]);
P.Targets.AddExampleProgram('ptcgl2.pp', AllUnixOSes + [win32, win64]);
P.Sources.AddExampleFiles('examples/*',false,'.');
{$ifndef ALLPACKAGES}

2
packages/ptc/src/core/aread.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

4
packages/ptc/src/core/areai.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -40,7 +40,7 @@ type
function GetBottom: Integer;
function GetWidth: Integer;
function GetHeight: Integer;
function Equals(AArea: IPTCArea): Boolean;
function Equals(AArea: IPTCArea): Boolean; reintroduce;
public
constructor Create;
constructor Create(ALeft, ATop, ARight, ABottom: Integer);

13
packages/ptc/src/core/baseconsoled.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -37,6 +37,10 @@ type
function GetTitle: string;
function GetInformation: string;
function GetOpenGL_Enabled: Boolean;
procedure SetOpenGL_Enabled(AValue: Boolean);
function GetOpenGL_Attributes: IPTCOpenGLAttributes;
procedure Configure(const AFileName: string);
function Modes: TPTCModeList;
procedure Open(const ATitle: string; APages: Integer = 0); overload;
@ -69,5 +73,12 @@ type
property Name: string read GetName;
property Title: string read GetTitle;
property Information: string read GetInformation;
{ OpenGL support }
property OpenGL_Enabled: Boolean read GetOpenGL_Enabled write SetOpenGL_Enabled;
property OpenGL_Attributes: IPTCOpenGLAttributes read GetOpenGL_Attributes;
procedure OpenGL_SwapBuffers;
procedure OpenGL_SetSwapInterval(AInterval: Integer);
function OpenGL_GetSwapInterval: Integer;
end;

56
packages/ptc/src/core/baseconsolei.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -48,6 +48,12 @@ type
function GetName: string; virtual; abstract;
function GetTitle: string; virtual; abstract;
function GetInformation: string; virtual; abstract;
function GetOpenGL_Enabled: Boolean; virtual; abstract;
procedure SetOpenGL_Enabled(AValue: Boolean); virtual; abstract;
function GetOpenGL_Attributes: IPTCOpenGLAttributes;
protected
FOpenGLAttributes: IPTCOpenGLAttributes;
public
constructor Create; virtual;
@ -120,11 +126,32 @@ type
property Pitch: Integer read GetPitch;
property Area: IPTCArea read GetArea;
property Format: IPTCFormat read GetFormat;
property OpenGL_Enabled: Boolean read GetOpenGL_Enabled write SetOpenGL_Enabled;
procedure OpenGL_SwapBuffers; virtual; abstract;
procedure OpenGL_SetSwapInterval(AInterval: Integer); virtual; abstract;
function OpenGL_GetSwapInterval: Integer; virtual; abstract;
end;
TPTCOpenGLLessConsole = class(TPTCBaseConsole)
private
function GetOpenGL_Enabled: Boolean; override;
procedure SetOpenGL_Enabled(AValue: Boolean); override;
public
procedure OpenGL_SwapBuffers; override;
procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
function OpenGL_GetSwapInterval: Integer; override;
end;
constructor TPTCBaseConsole.Create;
begin
FReleaseEnabled := False;
FOpenGLAttributes := TPTCOpenGLAttributes.Create;
end;
function TPTCBaseConsole.GetOpenGL_Attributes: IPTCOpenGLAttributes;
begin
Result := FOpenGLAttributes;
end;
function TPTCBaseConsole.KeyPressed: Boolean;
@ -178,3 +205,30 @@ function TPTCBaseConsole.GetKeyReleaseEnabled: Boolean;
begin
Result := FReleaseEnabled;
end;
function TPTCOpenGLLessConsole.GetOpenGL_Enabled: Boolean;
begin
Result := False;
end;
procedure TPTCOpenGLLessConsole.SetOpenGL_Enabled(AValue: Boolean);
begin
if AValue then
raise TPTCError.Create('Console does not support OpenGL');
end;
procedure TPTCOpenGLLessConsole.OpenGL_SwapBuffers;
begin
raise TPTCError.Create('Console does not support OpenGL');
end;
procedure TPTCOpenGLLessConsole.OpenGL_SetSwapInterval(AInterval: Integer);
begin
raise TPTCError.Create('Console does not support OpenGL');
end;
function TPTCOpenGLLessConsole.OpenGL_GetSwapInterval: Integer;
begin
Result := -1;
raise TPTCError.Create('Console does not support OpenGL');
end;

2
packages/ptc/src/core/basesurfaced.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/basesurfacei.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/cleard.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/cleari.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/clipperd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/clipperi.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/colord.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

4
packages/ptc/src/core/colori.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -44,7 +44,7 @@ type
function GetA: Single;
function GetDirect: Boolean;
function GetIndexed: Boolean;
function Equals(AColor: IPTCColor): Boolean;
function Equals(AColor: IPTCColor): Boolean; reintroduce;
public
constructor Create;
constructor Create(AIndex: Integer);

2
packages/ptc/src/core/consoled.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

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

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -37,6 +37,7 @@ type
FModes: array of IPTCMode;
FOptionsQueue: array of string;
FHackyOptionConsoleFlag: Boolean;
FUseOpenGL: Boolean;
function ConsoleCreate(AIndex: Integer): IPTCConsole;
function ConsoleCreate(const AName: string): IPTCConsole;
@ -45,6 +46,11 @@ type
procedure AddOptionToOptionsQueue(const AOption: string);
procedure ExecuteOptionsFromOptionsQueue;
procedure ClearOptionsQueue;
procedure PassOpenGLOptionsToInnerConsole;
function GetOpenGL_Enabled: Boolean; override;
procedure SetOpenGL_Enabled(AValue: Boolean); override;
public
constructor Create; override;
destructor Destroy; override;
@ -106,6 +112,9 @@ type
function GetInformation: string; override;
function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
procedure OpenGL_SwapBuffers; override;
procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
function OpenGL_GetSwapInterval: Integer; override;
end;
class function TPTCConsoleFactory.CreateNew: IPTCConsole;
@ -130,36 +139,36 @@ const
record
ConsoleClass: class of TPTCBaseConsole;
Names: array [1..2] of string;
OpenGL: Boolean;
end =
(
{$IFDEF GO32V2}
(ConsoleClass: TVESAConsole; Names: ('VESA', '')),
(ConsoleClass: TVGAConsole; Names: ('VGA', 'Fakemode')),
(ConsoleClass: TCGAConsole; Names: ('CGA', '')),
(ConsoleClass: TTEXTFX2Console; Names: ('TEXTFX2', 'Text'))
(ConsoleClass: TVESAConsole; Names: ('VESA', ''); OpenGL: False),
(ConsoleClass: TVGAConsole; Names: ('VGA', 'Fakemode'); OpenGL: False),
(ConsoleClass: TCGAConsole; Names: ('CGA', ''); OpenGL: False),
(ConsoleClass: TTEXTFX2Console; Names: ('TEXTFX2', 'Text'); OpenGL: False)
{$ENDIF GO32V2}
{$IF defined(Win32) OR defined(Win64)}
(ConsoleClass: TDirectXConsole; Names: ('DirectX', '')),
(ConsoleClass: TGDIConsole; Names: ('GDI', ''))
(ConsoleClass: TDirectXConsole; Names: ('DirectX', ''); OpenGL: False),
(ConsoleClass: TGDIConsole; Names: ('GDI', ''); OpenGL: True)
{$ENDIF defined(Win32) OR defined(Win64)}
{$IFDEF WinCE}
(ConsoleClass: TWinCEGAPIConsole; Names: ('GAPI', '')),
(ConsoleClass: TWinCEGDIConsole; Names: ('GDI', ''))
(ConsoleClass: TWinCEGAPIConsole; Names: ('GAPI', ''); OpenGL: False),
(ConsoleClass: TWinCEGDIConsole; Names: ('GDI', ''); OpenGL: False)
{$ENDIF WinCE}
{$IFDEF UNIX}
(ConsoleClass: TX11Console; Names: ('X11', ''))
(ConsoleClass: TX11Console; Names: ('X11', ''); OpenGL: {$IFDEF ENABLE_X11_EXTENSION_GLX}True{$ELSE}False{$ENDIF})
{$ENDIF UNIX}
);
constructor TPTCConsole.Create;
{$IFDEF UNIX}
var
I: Integer;
{$IFDEF UNIX}
s: AnsiString;
{$ENDIF UNIX}
{$ENDIF UNIX}
begin
inherited Create;
FConsole := nil;
@ -190,10 +199,8 @@ begin
end;
destructor TPTCConsole.Destroy;
var
I: Integer;
begin
close;
Close;
FConsole := nil;
inherited Destroy;
end;
@ -263,20 +270,17 @@ begin
if Assigned(FConsole) then
begin
FHackyOptionConsoleFlag := True;
PassOpenGLOptionsToInnerConsole;
ExecuteOptionsFromOptionsQueue;
{ ClearOptionsQueue;}
Result := True;
end
else
begin
{ TODO: check if the option is supported by at least one console... }
if {OptionSupported}True then
begin
AddOptionToOptionsQueue(AOption);
Result := True;
end
else
Result := False;
{ TODO: check if the option is supported by at least one console and return false otherwise... }
AddOptionToOptionsQueue(AOption);
Result := True;
end;
end;
end;
@ -334,7 +338,7 @@ begin
exit;
except
on error: TPTCError do begin
FreeAndNil(FConsole);
FConsole := nil;
if FHackyOptionConsoleFlag then
begin
FHackyOptionConsoleFlag := False;
@ -353,6 +357,7 @@ begin
FConsole := ConsoleCreate(index);
if FConsole = nil then
break;
PassOpenGLOptionsToInnerConsole;
ExecuteOptionsFromOptionsQueue;
FConsole.Open(ATitle, APages);
{ ClearOptionsQueue;}
@ -366,7 +371,7 @@ begin
finally
tmp.Free;
end;
FreeAndNil(FConsole);
FConsole := nil;
continue;
end;
end;
@ -376,7 +381,7 @@ begin
finally
composite.Free;
if not success then
FreeAndNil(FConsole);
FConsole := nil;
end;
end;
@ -394,7 +399,7 @@ begin
exit;
except
on error: TPTCError do begin
FreeAndNil(FConsole);
FConsole := nil;
if FHackyOptionConsoleFlag then
begin
FHackyOptionConsoleFlag := False;
@ -413,6 +418,7 @@ begin
FConsole := ConsoleCreate(index);
if FConsole = nil then
break;
PassOpenGLOptionsToInnerConsole;
ExecuteOptionsFromOptionsQueue;
FConsole.open(ATitle, AFormat, APages);
{ ClearOptionsQueue;}
@ -426,7 +432,7 @@ begin
finally
tmp.Free;
end;
FreeAndNil(FConsole);
FConsole := nil;
Continue;
end;
end;
@ -436,7 +442,7 @@ begin
finally
composite.Free;
if not success then
FreeAndNil(FConsole);
FConsole := nil;
end;
end;
@ -454,7 +460,7 @@ begin
exit;
except
on error: TPTCError do begin
FreeAndNil(FConsole);
FConsole := nil;
if FHackyOptionConsoleFlag then
begin
FHackyOptionConsoleFlag := False;
@ -473,6 +479,7 @@ begin
FConsole := ConsoleCreate(index);
if FConsole = nil then
Break;
PassOpenGLOptionsToInnerConsole;
ExecuteOptionsFromOptionsQueue;
FConsole.Open(ATitle, AWidth, AHeight, AFormat, APages);
{ ClearOptionsQueue;}
@ -486,7 +493,7 @@ begin
finally
tmp.Free;
end;
FreeAndNil(FConsole);
FConsole := nil;
Continue;
end;
end;
@ -496,7 +503,7 @@ begin
finally
composite.Free;
if not success then
FreeAndNil(FConsole);
FConsole := nil;
end;
end;
@ -514,7 +521,7 @@ begin
exit;
except
on error: TPTCError do begin
FreeAndNil(FConsole);
FConsole := nil;
if FHackyOptionConsoleFlag then
begin
FHackyOptionConsoleFlag := False;
@ -533,6 +540,7 @@ begin
FConsole := ConsoleCreate(index);
if FConsole = nil then
Break;
PassOpenGLOptionsToInnerConsole;
ExecuteOptionsFromOptionsQueue;
FConsole.Open(ATitle, AMode, APages);
{ ClearOptionsQueue;}
@ -546,7 +554,7 @@ begin
finally
tmp.Free;
end;
FreeAndNil(FConsole);
FConsole := nil;
Continue;
end;
end;
@ -556,7 +564,7 @@ begin
finally
composite.Free;
if not success then
FreeAndNil(FConsole);
FConsole := nil;
end;
end;
@ -780,10 +788,19 @@ begin
end;
function TPTCConsole.ConsoleCreate(AIndex: Integer): IPTCConsole;
var
ResultObj: TPTCBaseConsole;
begin
Result := nil;
if (AIndex >= Low(ConsoleTypes)) and (AIndex <= High(ConsoleTypes)) then
Result := ConsoleTypes[AIndex].ConsoleClass.Create;
begin
if OpenGL_Enabled and not ConsoleTypes[AIndex].OpenGL then
raise TPTCError.Create('Console does not support OpenGL');
ResultObj := ConsoleTypes[AIndex].ConsoleClass.Create;
Result := ResultObj;
ResultObj.FOpenGLAttributes := FOpenGLAttributes;
end;
if Result <> nil then
Result.KeyReleaseEnabled := KeyReleaseEnabled;
@ -802,13 +819,8 @@ begin
for J := Low(ConsoleTypes[I].Names) to High(ConsoleTypes[I].Names) do
if AName = ConsoleTypes[I].Names[J] then
begin
Result := ConsoleTypes[I].ConsoleClass.Create;
if Result <> nil then
begin
Result.KeyReleaseEnabled := KeyReleaseEnabled;
exit;
end;
Result := ConsoleCreate(I);
exit;
end;
end;
@ -817,3 +829,42 @@ begin
if FConsole = nil then
raise TPTCError.Create('console is not open (core)');
end;
procedure TPTCConsole.PassOpenGLOptionsToInnerConsole;
begin
FConsole.OpenGL_Enabled := FUseOpenGL;
end;
function TPTCConsole.GetOpenGL_Enabled: Boolean;
begin
if FConsole <> nil then
Result := FConsole.OpenGL_Enabled
else
Result := FUseOpenGL;
end;
procedure TPTCConsole.SetOpenGL_Enabled(AValue: Boolean);
begin
if FConsole <> nil then
FConsole.OpenGL_Enabled := AValue
else
FUseOpenGL := AValue;
end;
procedure TPTCConsole.OpenGL_SwapBuffers;
begin
Check;
FConsole.OpenGL_SwapBuffers;
end;
procedure TPTCConsole.OpenGL_SetSwapInterval(AInterval: Integer);
begin
Check;
FConsole.OpenGL_SetSwapInterval(AInterval);
end;
function TPTCConsole.OpenGL_GetSwapInterval: Integer;
begin
Check;
Result := FConsole.OpenGL_GetSwapInterval;
end;

2
packages/ptc/src/core/copyd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/copyi.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

1
packages/ptc/src/core/coreimplementation.inc
View File

@ -11,6 +11,7 @@
{$INCLUDE copyi.inc}
{$INCLUDE clipperi.inc}
{$INCLUDE basesurfacei.inc}
{$INCLUDE openglattributesi.inc}
{$INCLUDE baseconsolei.inc}
{$INCLUDE surfacei.inc}
{$INCLUDE timeri.inc}

1
packages/ptc/src/core/coreinterface.inc
View File

@ -11,6 +11,7 @@
{$INCLUDE clipperd.inc}
{$INCLUDE basesurfaced.inc}
{$INCLUDE surfaced.inc}
{$INCLUDE openglattributesd.inc}
{$INCLUDE baseconsoled.inc}
{$INCLUDE consoled.inc}
{$INCLUDE errord.inc}

4
packages/ptc/src/core/errord.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009, 2010, 2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -41,7 +41,7 @@ type
constructor Create(const AError: TPTCError);
destructor Destroy; override;
procedure Assign(const AError: TPTCError);
function Equals(const AError: TPTCError): Boolean;
function Equals(Obj: TObject): Boolean; override;
procedure Report;
property Message: string read FMessage;
end;

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

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009, 2010, 2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -62,9 +62,23 @@ begin
FMessage := AError.FMessage;
end;
function TPTCError.Equals(const AError: TPTCError): Boolean;
function TPTCError.Equals(Obj: TObject): Boolean;
var
OtherError: TPTCError;
begin
Equals := (FMessage = AError.FMessage);
if Obj = nil then
exit(False);
if Obj = Self then
exit(True);
if Obj is TPTCError then
begin
OtherError := TPTCError(Obj);
Equals := (FMessage = OtherError.FMessage);
end
else
Result := False;
end;
procedure TPTCError.Report;

2
packages/ptc/src/core/eventd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/eventi.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/formatd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

4
packages/ptc/src/core/formati.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -35,7 +35,7 @@ type
private
FFormat: THermesFormat;
function GetHermesFormat: PHermesFormat;
function Equals(AFormat: IPTCFormat): Boolean;
function Equals(AFormat: IPTCFormat): Boolean; reintroduce;
function GetR: Uint32;
function GetG: Uint32;
function GetB: Uint32;

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

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -175,5 +175,6 @@ const
PTCKEY_INSERT = $9B;
PTCKEY_HELP = $9C;
PTCKEY_META = $9D;
PTCKEY_MINUS = $BD;
PTCKEY_BACKQUOTE = $C0;
PTCKEY_QUOTE = $DE;

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

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/log.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/moded.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

4
packages/ptc/src/core/modei.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -46,7 +46,7 @@ type
constructor Create(AWidth, AHeight: Integer; AFormat: IPTCFormat);
constructor Create(AMode: IPTCMode);
{ procedure Assign(const mode: TPTCMode);}
function Equals(AMode: IPTCMode): Boolean;
function Equals(AMode: IPTCMode): Boolean; reintroduce;
{ property Valid: Boolean read GetValid;
property Width: Integer read GetWidth;
property Height: Integer read GetHeight;

2
packages/ptc/src/core/mouseeventd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/mouseeventi.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

62
packages/ptc/src/core/openglattributesd.inc Normal file
View File

@ -0,0 +1,62 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2012 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
IPTCOpenGLAttributes = interface
function GetDoubleBuffer: Boolean;
procedure SetDoubleBuffer(ADoubleBuffer: Boolean);
function GetDoubleBufferDontCare: Boolean;
procedure SetDoubleBufferDontCare(ADoubleBufferDontCare: Boolean);
function GetStereo: Boolean;
procedure SetStereo(AStereo: Boolean);
function GetStereoDontCare: Boolean;
procedure SetStereoDontCare(AStereoDontCare: Boolean);
function GetBufferSize: Integer;
procedure SetBufferSize(ABufferSize: Integer);
function GetDepthSize: Integer;
procedure SetDepthSize(ADepthSize: Integer);
function GetStencilSize: Integer;
procedure SetStencilSize(AStencilSize: Integer);
property DoubleBuffer: Boolean read GetDoubleBuffer write SetDoubleBuffer;
property DoubleBufferDontCare: Boolean read GetDoubleBufferDontCare write SetDoubleBufferDontCare;
property Stereo: Boolean read GetStereo write SetStereo;
property StereoDontCare: Boolean read GetStereoDontCare write SetStereoDontCare;
property BufferSize: Integer read GetBufferSize write SetBufferSize;
property DepthSize: Integer read GetDepthSize write SetDepthSize;
property StencilSize: Integer read GetStencilSize write SetStencilSize;
end;

149
packages/ptc/src/core/openglattributesi.inc Normal file
View File

@ -0,0 +1,149 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2012 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
TPTCOpenGLAttributes = class(TInterfacedObject, IPTCOpenGLAttributes)
private
FDoubleBuffer: Boolean;
FDoubleBufferDontCare: Boolean;
FStereo: Boolean;
FStereoDontCare: Boolean;
FBufferSize: Integer;
FDepthSize: Integer;
FStencilSize: Integer;
public
constructor Create;
function GetDoubleBuffer: Boolean;
procedure SetDoubleBuffer(ADoubleBuffer: Boolean);
function GetDoubleBufferDontCare: Boolean;
procedure SetDoubleBufferDontCare(ADoubleBufferDontCare: Boolean);
function GetStereo: Boolean;
procedure SetStereo(AStereo: Boolean);
function GetStereoDontCare: Boolean;
procedure SetStereoDontCare(AStereoDontCare: Boolean);
function GetBufferSize: Integer;
procedure SetBufferSize(ABufferSize: Integer);
function GetDepthSize: Integer;
procedure SetDepthSize(ADepthSize: Integer);
function GetStencilSize: Integer;
procedure SetStencilSize(AStencilSize: Integer);
end;
constructor TPTCOpenGLAttributes.Create;
begin
inherited;
FDoubleBuffer := True;
FDoubleBufferDontCare := False;
FStereo := False;
FStereoDontCare := False;
FBufferSize := 0;
FDepthSize := 0;
FStencilSize := 0;
end;
function TPTCOpenGLAttributes.GetDoubleBuffer: Boolean;
begin
Result := FDoubleBuffer;
end;
procedure TPTCOpenGLAttributes.SetDoubleBuffer(ADoubleBuffer: Boolean);
begin
FDoubleBuffer := ADoubleBuffer;
end;
function TPTCOpenGLAttributes.GetDoubleBufferDontCare: Boolean;
begin
Result := FDoubleBufferDontCare;
end;
procedure TPTCOpenGLAttributes.SetDoubleBufferDontCare(ADoubleBufferDontCare: Boolean);
begin
FDoubleBufferDontCare := ADoubleBufferDontCare;
end;
function TPTCOpenGLAttributes.GetStereo: Boolean;
begin
Result := FStereo;
end;
procedure TPTCOpenGLAttributes.SetStereo(AStereo: Boolean);
begin
FStereo := AStereo;
end;
function TPTCOpenGLAttributes.GetStereoDontCare: Boolean;
begin
Result := FStereoDontCare;
end;
procedure TPTCOpenGLAttributes.SetStereoDontCare(AStereoDontCare: Boolean);
begin
FStereoDontCare := AStereoDontCare;
end;
function TPTCOpenGLAttributes.GetBufferSize: Integer;
begin
Result := FBufferSize;
end;
procedure TPTCOpenGLAttributes.SetBufferSize(ABufferSize: Integer);
begin
FBufferSize := ABufferSize;
end;
function TPTCOpenGLAttributes.GetDepthSize: Integer;
begin
Result := FDepthSize;
end;
procedure TPTCOpenGLAttributes.SetDepthSize(ADepthSize: Integer);
begin
FDepthSize := ADepthSize;
end;
function TPTCOpenGLAttributes.GetStencilSize: Integer;
begin
Result := FStencilSize;
end;
procedure TPTCOpenGLAttributes.SetStencilSize(AStencilSize: Integer);
begin
FStencilSize := AStencilSize;
end;

2
packages/ptc/src/core/paletted.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/palettei.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/surfaced.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/surfacei.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/timerd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/core/timeri.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/dos/base/moused.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/dos/base/mousei.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

4
packages/ptc/src/dos/cga/cgaconsoled.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2012 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
@ -30,7 +30,7 @@
}
type
TCGAConsole = class(TPTCBaseConsole)
TCGAConsole = class(TPTCOpenGLLessConsole)
private
{ data }
m_modes: array of IPTCMode;

2
packages/ptc/src/dos/cga/cgaconsolei.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2011 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

4
packages/ptc/src/dos/textfx2/textfx2consoled.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2012 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
@ -30,7 +30,7 @@
}
type
TTextFX2Console = class(TPTCBaseConsole)
TTextFX2Console = class(TPTCOpenGLLessConsole)
private
{ data }
FModes: array of IPTCMode;

2
packages/ptc/src/dos/textfx2/textfx2consolei.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2011 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

4
packages/ptc/src/dos/vesa/vesaconsoled.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2012 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
@ -30,7 +30,7 @@
}
type
TVESAConsole = class(TPTCBaseConsole)
TVESAConsole = class(TPTCOpenGLLessConsole)
private
{ data }
FModes: array of IPTCMode;

2
packages/ptc/src/dos/vesa/vesaconsolei.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2011 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

4
packages/ptc/src/dos/vga/vgaconsoled.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2012 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
@ -30,7 +30,7 @@
}
type
TVGAConsole = class(TPTCBaseConsole)
TVGAConsole = class(TPTCOpenGLLessConsole)
private
{ data }
m_modes: array of IPTCMode;

2
packages/ptc/src/dos/vga/vgaconsolei.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2011 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

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

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -60,7 +60,7 @@ uses
{$ENDIF FPDOC}
const
PTCPAS_VERSION = 'PTCPas 0.99.12';
PTCPAS_VERSION = 'PTCPas 0.99.13';
type
PUint8 = ^Uint8;
@ -113,7 +113,7 @@ uses
{$IF defined(WIN32) OR defined(WIN64)}
uses
Windows, p_ddraw;
Windows, p_ddraw, glext;
{$ENDIF defined(WIN32) OR defined(WIN64)}
{$IFDEF WinCE}
@ -123,7 +123,7 @@ uses
{$IFDEF UNIX}
uses
BaseUnix, Unix, ctypes, x, xlib, xutil, xatom, keysym
BaseUnix, Unix, ctypes, x, xlib, xutil, xatom, keysym, xkblib
{$IFDEF ENABLE_X11_EXTENSION_XRANDR}
, xrandr
{$ENDIF ENABLE_X11_EXTENSION_XRANDR}
@ -136,6 +136,9 @@ uses
{$IFDEF ENABLE_X11_EXTENSION_XSHM}
, xshm, ipc
{$ENDIF ENABLE_X11_EXTENSION_XSHM}
{$IFDEF ENABLE_X11_EXTENSION_GLX}
, glx
{$ENDIF ENABLE_X11_EXTENSION_GLX}
;
{$ENDIF UNIX}
@ -198,6 +201,9 @@ end;
{$INCLUDE win32/directx/primaryd.inc}
{$INCLUDE win32/directx/directxconsoled.inc}
{$INCLUDE win32/gdi/win32dibd.inc}
{$INCLUDE win32/gdi/win32modesetterd.inc}
{$INCLUDE win32/gdi/win32openglwindowd.inc}
{$INCLUDE win32/gdi/gdihookd.inc}
{$INCLUDE win32/gdi/gdiconsoled.inc}
{$INCLUDE win32/base/cursor.inc}
@ -215,6 +221,9 @@ end;
{$INCLUDE win32/directx/primary.inc}
{$INCLUDE win32/directx/directxconsolei.inc}
{$INCLUDE win32/gdi/win32dibi.inc}
{$INCLUDE win32/gdi/win32modesetteri.inc}
{$INCLUDE win32/gdi/win32openglwindowi.inc}
{$INCLUDE win32/gdi/gdihooki.inc}
{$INCLUDE win32/gdi/gdiconsolei.inc}
{$ENDIF defined(Win32) OR defined(Win64)}

2
packages/ptc/src/ptcwrapper/ptceventqueue.pp
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2010, 2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

4
packages/ptc/src/ptcwrapper/ptcwrapper.pp
View File

@ -1,6 +1,6 @@
{
Free Pascal PTCPas framebuffer library threaded wrapper
Copyright (C) 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2010, 2011, 2012 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
@ -259,8 +259,6 @@ procedure TPTCWrapperThread.Execute;
end;
end;
var
I: Integer;
begin
try
FConsole := TPTCConsoleFactory.CreateNew;

2
packages/ptc/src/win32/base/cursor.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/win32/base/cursord.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/win32/base/event.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/win32/base/eventd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

4
packages/ptc/src/win32/base/hook.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009, 2010, 2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -38,7 +38,7 @@ type
PWin32Hook_Lookup = ^TWin32Hook_Lookup;
TWin32Hook_Lookup = record
window: HWND;
wndproc: PtrUInt;
wndproc: LONG_PTR;
hook: array [0..15] of TWin32Hook;
count: Integer;
end;

2
packages/ptc/src/win32/base/hookd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

15
packages/ptc/src/win32/base/kbd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -30,6 +30,11 @@
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
{$WARNING this should be in the windows unit}
const
VK_OEM_COMMA = $BC;
VK_OEM_PERIOD = $BE;
constructor TWin32Keyboard.Create(AWindow: HWND; AThread: DWord; AMultithreaded: Boolean; AEventQueue: TEventQueue);
begin
FMonitor := nil;
@ -133,6 +138,14 @@ begin
KeyCode := wParam;
if wParam = VK_RETURN then
KeyCode := PTCKEY_ENTER;
if wParam = VK_INSERT then
KeyCode := PTCKEY_INSERT;
if wParam = VK_DELETE then
KeyCode := PTCKEY_DELETE;
if wParam = VK_OEM_COMMA then
KeyCode := PTCKEY_COMMA;
if wParam = VK_OEM_PERIOD then
KeyCode := PTCKEY_PERIOD;
{ handle key repeat count }
for i := 1 to lParam and $FFFF do

2
packages/ptc/src/win32/base/kbdd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/win32/base/monitor.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/win32/base/monitord.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/win32/base/moused.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/win32/base/mousei.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2007, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

190
packages/ptc/src/win32/base/window.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -43,11 +43,86 @@ begin
FManaged := False;
end;
constructor TWin32Window.Create(const AWndClass, ATitle: string; AExtra, AStyle: DWord;
AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded: Boolean;
AData: Pointer);
function WndProcSingleThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; forward;
function WndProcMultiThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; forward;
constructor TWin32Window.Create(const AWndClass, ATitle: string; AExtra, AStyle, AClassStyle: DWord;
AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded,
ACursor: Boolean);
var
program_instance{, library_instance}: DWord;
rectangle: RECT;
display_width, display_height: Integer;
wc: WNDCLASSEX;
begin
internal_create(AWndClass, ATitle, AExtra, AStyle, AShow, AX, AY, AWidth, AHeight, ACenter, AMultithreaded, AData);
LOG('creating managed window');
Defaults;
FMultithreaded := AMultithreaded;
try
program_instance := GetModuleHandle(nil);
{ library_instance := program_instance;}
wc.cbSize := SizeOf(WNDCLASSEX);
wc.hInstance := program_instance;
wc.lpszClassName := PChar(AWndClass);
wc.style := AClassStyle;
wc.hIcon := 0{LoadIcon(library_instance, 'IDI_PTC_ICON')};
wc.hIconSm := 0;
wc.lpszMenuName := nil;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)}
if AMultithreaded then
wc.lpfnWndProc := @WndProcMultiThreaded
else
wc.lpfnWndProc := @WndProcSingleThreaded;
if ACursor then
wc.hCursor := LoadCursor(0, IDC_ARROW)
else
wc.hCursor := 0;
RegisterClassEx(wc);
with rectangle do
begin
left := 0;
top := 0;
right := AWidth;
bottom := AHeight;
end;
AdjustWindowRectEx(rectangle, AStyle, False, AExtra);
if ACenter then
begin
LOG('centering window');
display_width := GetSystemMetrics(SM_CXSCREEN);
display_height := GetSystemMetrics(SM_CYSCREEN);
AX := (display_width - (rectangle.right - rectangle.left)) div 2;
AY := (display_height - (rectangle.bottom - rectangle.top)) div 2;
end;
FName := AWndClass;
FTitle := ATitle;
FExtra := AExtra;
FStyle := AStyle;
FShow := AShow;
FX := AX;
FY := AY;
FWidth := rectangle.right - rectangle.left;
FHeight := rectangle.bottom - rectangle.top;
if AMultithreaded then
begin
{...}
end
else
begin
FWindow := CreateWindowEx(FExtra, PChar(FName), PChar(FTitle), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, Self);
if not IsWindow(FWindow) then
raise TPTCError.Create('could not create window');
ShowWindow(FWindow, FShow);
SetFocus(FWindow);
SetActiveWindow(FWindow);
SetForegroundWindow(FWindow);
end;
except
on error: TPTCError do
raise TPTCError.Create('could not create window', error);
end;
end;
destructor TWin32Window.Destroy;
@ -163,8 +238,23 @@ begin
end;
function WndProcSingleThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
WindowObject: TWin32Window;
pCreate: PCREATESTRUCT;
begin
case message of
WM_CREATE:
begin
pCreate := PCREATESTRUCT(lParam);
WindowObject := TWin32Window(pCreate^.lpCreateParams);
SetWindowLongPtr(hWnd, GWLP_USERDATA, LONG_PTR(WindowObject));
Result := WindowObject.WMCreate(hWnd, message, wParam, lParam);
end;
WM_DESTROY:
begin
WindowObject := TWin32Window(GetWindowLongPtr(hWnd, GWLP_USERDATA));
Result := WindowObject.WMDestroy(hWnd, message, wParam, lParam);
end;
WM_SYSCOMMAND:
begin
{ this fixes the pausing of the application when the Alt or F10 key is pressed }
@ -227,83 +317,6 @@ begin
end;
end;
procedure TWin32Window.internal_create(const AWndClass, ATitle: string; AExtra, AStyle: DWord;
AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded: Boolean;
AData: Pointer);
var
program_instance{, library_instance}: DWord;
rectangle: RECT;
display_width, display_height: Integer;
wc: WNDCLASSEX;
begin
LOG('creating managed window');
Defaults;
FMultithreaded := AMultithreaded;
try
program_instance := GetModuleHandle(nil);
{ library_instance := program_instance;}
wc.cbSize := SizeOf(WNDCLASSEX);
wc.hInstance := program_instance;
wc.lpszClassName := PChar(AWndClass);
wc.style := CS_VREDRAW or CS_HREDRAW;
wc.hIcon := 0{LoadIcon(library_instance, 'IDI_PTC_ICON')};
wc.hIconSm := 0;
wc.lpszMenuName := nil;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)}
if AMultithreaded then
wc.lpfnWndProc := @WndProcMultiThreaded
else
wc.lpfnWndProc := @WndProcSingleThreaded;
wc.hCursor := LoadCursor(0, IDC_ARROW);
RegisterClassEx(wc);
with rectangle do
begin
left := 0;
top := 0;
right := AWidth;
bottom := AHeight;
end;
AdjustWindowRectEx(rectangle, AStyle, False, AExtra);
if ACenter then
begin
LOG('centering window');
display_width := GetSystemMetrics(SM_CXSCREEN);
display_height := GetSystemMetrics(SM_CYSCREEN);
AX := (display_width - (rectangle.right - rectangle.left)) div 2;
AY := (display_height - (rectangle.bottom - rectangle.top)) div 2;
end;
FName := AWndClass;
FTitle := ATitle;
FExtra := AExtra;
FStyle := AStyle;
FShow := AShow;
FX := AX;
FY := AY;
FWidth := rectangle.right - rectangle.left;
FHeight := rectangle.bottom - rectangle.top;
FData := AData;
if AMultithreaded then
begin
{...}
end
else
begin
FWindow := CreateWindowEx(FExtra, PChar(FName), PChar(FTitle), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, FData);
if not IsWindow(FWindow) then
raise TPTCError.Create('could not create window');
ShowWindow(FWindow, FShow);
SetFocus(FWindow);
SetActiveWindow(FWindow);
SetForegroundWindow(FWindow);
end;
except
on error: TPTCError do
raise TPTCError.Create('could not create window', error);
end;
end;
procedure TWin32Window.Defaults;
begin
FWindow := 0;
@ -319,7 +332,6 @@ begin
FY := 0;
FWidth := 0;
FHeight := 0;
FData := nil;
FManaged := True;
FMultithreaded := False;
end;
@ -367,7 +379,7 @@ var
begin
with AOwner do
begin
FWindow := CreateWindowEx(FExtra, PChar(FName), PChar(FTitle), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, FData);
FWindow := CreateWindowEx(FExtra, PChar(FName), PChar(FTitle), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, nil);
if IsWindow(FWindow) then
begin
ShowWindow(FWindow, FShow);
@ -384,3 +396,13 @@ begin
SetEvent(FEvent);
end;
end;
function TWin32Window.WMCreate(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
function TWin32Window.WMDestroy(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;

14
packages/ptc/src/win32/base/windowd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009, 2010, 2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -44,26 +44,24 @@ type
FShow: Integer;
FX, FY: Integer;
FWidth, FHeight: Integer;
FData: Pointer;
FManaged: Boolean;
FMultithreaded: Boolean;
FCursorConfineInEffect: Boolean;
{ class function WndProcSingleThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;
class function WndProcMultiThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;}
procedure internal_create(const AWndClass, ATitle: string; AExtra, AStyle: DWord;
AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded: Boolean;
AData: Pointer);
procedure Defaults;
procedure Close;
function GetThread: DWord;
class procedure ThreadFunction(AOwner: TWin32Window);
protected
function WMCreate(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; virtual;
function WMDestroy(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; virtual;
public
constructor Create(window: HWND);
constructor Create(const AWndClass, ATitle: string; AExtra, AStyle: DWord;
AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded: Boolean;
AData: Pointer = nil);
constructor Create(const AWndClass, ATitle: string; AExtra, AStyle, AClassStyle: DWord;
AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded, ACursor: Boolean);
destructor Destroy; override;
procedure Cursor(AFlag: Boolean);
procedure ConfineCursor(AFlag: Boolean);

2
packages/ptc/src/win32/directx/check.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

4
packages/ptc/src/win32/directx/directxconsoled.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -32,7 +32,7 @@
type
TPrimaryModeEnum = (DIRECT, SECONDARY);
TDirectXConsole = class(TPTCBaseConsole)
TDirectXConsole = class(TPTCOpenGLLessConsole)
private
{ title data }
{ FTitle: array [0..1023] of Char;}

17
packages/ptc/src/win32/directx/directxconsolei.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -313,18 +313,14 @@ begin
if AOption = 'grab mouse' then
begin
if FOpen and (not FFullscreen) then
begin
FWindow.ConfineCursor(True);
end;
FGrabMouse := True;
exit;
end;
if AOption = 'ungrab mouse' then
begin
if FOpen and (not FFullscreen) then
begin
FWindow.ConfineCursor(False);
end;
FGrabMouse := False;
exit;
end;
@ -1028,17 +1024,15 @@ begin
FTitle,
WS_EX_TOPMOST,
DWord(WS_POPUP or WS_SYSMENU or WS_VISIBLE), // fpc windows RTL bug - WS_POPUP should be a DWord!!!
CS_VREDRAW or CS_HREDRAW,
SW_NORMAL,
0, 0,
GetSystemMetrics(SM_CXSCREEN),
GetSystemMetrics(SM_CYSCREEN),
False, False)
False, False, FCursor)
else
FWindow := TWin32Window.Create(window);
{ set window cursor }
FWindow.Cursor(FCursor);
if FCursor then
FWin32Cursor.Show
else
@ -1147,12 +1141,11 @@ begin
extended := WS_EX_TOPMOST;
case FWindowMode of
RESIZABLE: FWindow := TWin32Window.Create('PTC_DIRECTX_WINDOWED_RESIZABLE', FTitle,
extended, WS_OVERLAPPEDWINDOW or WS_VISIBLE, SW_NORMAL, CW_USEDEFAULT, CW_USEDEFAULT, mode.width, mode.height, FCenterWindow, False);
extended, WS_OVERLAPPEDWINDOW or WS_VISIBLE, CS_VREDRAW or CS_HREDRAW, SW_NORMAL, CW_USEDEFAULT, CW_USEDEFAULT, mode.width, mode.height, FCenterWindow, False, FCursor);
FIXED: FWindow := TWin32Window.Create('PTC_DIRECTX_WINDOWED_FIXED', FTitle,
extended, WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX, SW_NORMAL, CW_USEDEFAULT, CW_USEDEFAULT, mode.width, mode.height, FCenterWindow, False);
extended, WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX, CS_VREDRAW or CS_HREDRAW, SW_NORMAL, CW_USEDEFAULT, CW_USEDEFAULT, mode.width, mode.height, FCenterWindow, False, FCursor);
end;
end;
FWindow.Cursor(FCursor);
FDisplay.cooperative(FWindow.handle, False);
end;

2
packages/ptc/src/win32/directx/display.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/win32/directx/displayd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

18
packages/ptc/src/win32/directx/hook.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -139,6 +139,22 @@ begin
end;
end;
end;
WM_PALETTECHANGED:
begin
LOG('TDirectXHook WM_PALETTECHANGED');
if Windows.HWND(wParam) <> hWnd then
begin
LOG('not our window');
if FConsole.FPrimary.Active then
begin
FConsole.FPrimary.ResetPalette;
end;
end;
end;
WM_QUERYNEWPALETTE:
begin
LOG('TDirectXHook WM_QUERYNEWPALETTE');
end;
WM_CLOSE: begin
LOG('TDirectXHook WM_CLOSE');

2
packages/ptc/src/win32/directx/hookd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/win32/directx/library.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

2
packages/ptc/src/win32/directx/libraryd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009, 2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

15
packages/ptc/src/win32/directx/primary.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -483,22 +483,27 @@ begin
end;
procedure TDirectXPrimary.Palette(APalette: IPTCPalette);
begin
Block;
FPalette.Load(APalette.Data);
ResetPalette;
end;
procedure TDirectXPrimary.ResetPalette;
var
data: PUint32;
temp: array [0..255] of PALETTEENTRY;
I: Integer;
DDP: IDirectDrawPalette;
begin
Block;
FPalette.Load(APalette.Data);
if not FFormat.Indexed then
begin
LOG('palette set in direct color');
end
else
begin
data := APalette.Data;
data := FPalette.Data;
for I := 0 to 255 do
begin
temp[I].peRed := (data[I] and $00FF0000) shr 16;

3
packages/ptc/src/win32/directx/primaryd.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2009-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or
@ -96,6 +96,7 @@ type
procedure Clear(AColor: IPTCColor; const AArea: IPTCArea);
procedure Palette(APalette: IPTCPalette);
procedure ResetPalette;
function Palette: IPTCPalette;
procedure Clip(const AArea: IPTCArea);

2
packages/ptc/src/win32/directx/translate.inc
View File

@ -1,6 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2003, 2006, 2007, 2009-2011 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This library is free software; you can redistribute it and/or

20
packages/ptc/src/win32/gdi/gdiconsoled.inc
View File

@ -1,7 +1,6 @@
{
Free Pascal port of the OpenPTC C++ library.
Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
Original C++ version by Glenn Fiedler (ptc@gaffer.org)
This file is part of the PTCPas framebuffer library
Copyright (C) 2007, 2009-2012 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
@ -37,6 +36,8 @@ type
FWin32DIB: TWin32DIB;
FKeyboard: TWin32Keyboard;
FMouse: TWin32Mouse;
FWin32Cursor: TWin32Cursor;
FHook: TGDIHook;
FCopy: TPTCCopy;
FClear: TPTCClear;
@ -46,6 +47,10 @@ type
FPalette: IPTCPalette;
FModes: array of IPTCMode;
FFullscreen: Boolean;
FModeSetter: TWin32ModeSetter;
FGrabMouse: Boolean;
FOpen: Boolean;
FLocked: Boolean;
FCursor: Boolean;
@ -60,6 +65,8 @@ type
FDefaultHeight: Integer;
FDefaultFormat: IPTCFormat;
FUseOpenGL: Boolean;
procedure UpdateCursor;
function GetWidth: Integer; override;
@ -72,6 +79,9 @@ type
function GetTitle: string; override;
function GetInformation: string; override;
function GetOpenGL_Enabled: Boolean; override;
procedure SetOpenGL_Enabled(AValue: Boolean); override;
procedure CheckOpen(const AMessage: string);
procedure CheckUnlocked(const AMessage: string);
public
@ -134,4 +144,8 @@ type
function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
procedure OpenGL_SwapBuffers; override;
procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
function OpenGL_GetSwapInterval: Integer; override;
end;

205
packages/ptc/src/win32/gdi/gdiconsolei.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2007, 2009-2012 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
@ -38,8 +38,8 @@ begin
FDisplayWidth := GetSystemMetrics(SM_CXSCREEN);
FDisplayHeight := GetSystemMetrics(SM_CYSCREEN);
FDefaultWidth := 320;
FDefaultHeight := 200;
FDefaultWidth := 640;
FDefaultHeight := 480;
FDefaultFormat := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
FCopy := TPTCCopy.Create;
@ -47,6 +47,11 @@ begin
FArea := TPTCArea.Create;
FClip := TPTCArea.Create;
FPalette := TPTCPalette.Create;
FWin32Cursor := TWin32Cursor.Create;
FFullscreen := True;
FModeSetter := TWin32ModeSetter.Create;
FOpen := False;
@ -65,11 +70,14 @@ begin
{...}
FModeSetter.Free;
FWin32DIB.Free;
FWindow.Free;
FEventQueue.Free;
FCopy.Free;
FClear.Free;
FWin32Cursor.Free;
inherited Destroy;
end;
@ -99,44 +107,112 @@ begin
if FOpen then
Close;
case FCursorMode of
CURSOR_DEFAULT:
FCursor := not FFullScreen;
CURSOR_SHOW:
FCursor := True;
CURSOR_HIDE:
FCursor := False;
end;
if FFullscreen then
begin
FModeSetter.Save;
FModeSetter.Open(AWidth, AHeight, AFormat);
end;
(* FWindow := TWin32Window.Create('PTC_GDI_FULLSCREEN',
ATitle,
WS_EX_TOPMOST,
DWord(WS_POPUP or WS_SYSMENU or WS_VISIBLE), // fpc windows RTL bug - WS_POPUP should be a DWord!!!
CS_HREDRAW or CS_VREDRAW,
SW_NORMAL,
0, 0,
GetSystemMetrics(SM_CXSCREEN),
GetSystemMetrics(SM_CYSCREEN),
False, False);*)
FWindow := TWin32Window.Create('PTC_GDI_WINDOWED_FIXED',
ATitle,
0,
WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX,
SW_NORMAL,
CW_USEDEFAULT, CW_USEDEFAULT,
AWidth, AHeight,
{m_center_window}False,
False);
(* FWindow := TWin32Window.Create('PTC_GDI_WINDOWED_RESIZABLE',
ATitle,
0,
WS_OVERLAPPEDWINDOW or WS_VISIBLE,
CS_HREDRAW or CS_VREDRAW,
SW_NORMAL,
CW_USEDEFAULT, CW_USEDEFAULT,
AWidth, AHeight,
{m_center_window}False,
False);*)
if FFullscreen then
begin
if FUseOpenGL then
FWindow := TWin32OpenGLWindow.Create('PTC_OPENGL_FULLSCREEN',
ATitle,
WS_EX_TOPMOST or WS_EX_APPWINDOW,
WS_VISIBLE or WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
CS_HREDRAW or CS_VREDRAW or CS_OWNDC,
SW_NORMAL,
CW_USEDEFAULT, CW_USEDEFAULT,
AWidth, AHeight,
{m_center_window}False,
False,
FCursor,
FOpenGLAttributes)
else
FWindow := TWin32Window.Create('PTC_GDI_FULLSCREEN',
ATitle,
WS_EX_TOPMOST or WS_EX_APPWINDOW,
WS_VISIBLE or WS_POPUP,
CS_HREDRAW or CS_VREDRAW,
SW_NORMAL,
CW_USEDEFAULT, CW_USEDEFAULT,
AWidth, AHeight,
{m_center_window}False,
False,
FCursor);
end
else
begin
if FUseOpenGL then
FWindow := TWin32OpenGLWindow.Create('PTC_OPENGL_WINDOWED_FIXED',
ATitle,
0,
WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX or WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
CS_HREDRAW or CS_VREDRAW or CS_OWNDC,
SW_NORMAL,
CW_USEDEFAULT, CW_USEDEFAULT,
AWidth, AHeight,
{m_center_window}False,
False,
FCursor,
FOpenGLAttributes)
else
FWindow := TWin32Window.Create('PTC_GDI_WINDOWED_FIXED',
ATitle,
0,
WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX,
CS_HREDRAW or CS_VREDRAW,
SW_NORMAL,
CW_USEDEFAULT, CW_USEDEFAULT,
AWidth, AHeight,
{m_center_window}False,
False,
FCursor);
end;
FWin32DIB := TWin32DIB.Create(AWidth, AHeight);
FreeAndNil(FKeyboard);
FreeAndNil(FMouse);
FreeAndNil(FHook);
FreeAndNil(FEventQueue);
FEventQueue := TEventQueue.Create;
FHook := TGDIHook.Create(Self, FWindow.Handle, FWindow.Thread, FCursor, {AManaged}True, FFullScreen);
FKeyboard := TWin32Keyboard.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue);
FMouse := TWin32Mouse.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue, {FFullScreen}False, AWidth, AHeight);
FMouse := TWin32Mouse.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue, FFullScreen, AWidth, AHeight);
if FFullscreen then
FMouse.SetWindowArea(0, 0, AWidth, AHeight);
tmpArea := TPTCArea.Create(0, 0, AWidth, AHeight);
FArea := tmpArea;
@ -144,6 +220,13 @@ begin
FWindow.Update;
{ hide/show cursor globally if running fullscreen }
if FFullscreen then
if FCursor then
FWin32Cursor.Show
else
FWin32Cursor.Hide;
FTitle := ATitle;
FOpen := True;
@ -156,8 +239,16 @@ begin
{...}
if FFullscreen then
begin
FModeSetter.Close;
FModeSetter.Restore;
FWin32Cursor.Show;
end;
FreeAndNil(FKeyboard);
FreeAndNil(FMouse);
FreeAndNil(FHook);
FreeAndNil(FWin32DIB);
FreeAndNil(FWindow);
@ -273,22 +364,25 @@ begin
case FCursorMode of
CURSOR_DEFAULT:
FCursor := {Not FFullScreen}True;
FCursor := not FFullScreen;
CURSOR_SHOW:
FCursor := True;
CURSOR_HIDE:
FCursor := False;
end;
{ update hook cursor }
FHook.Cursor(FCursor);
{ update window cursor }
FWindow.Cursor(FCursor);
{ hide/show cursor globally if running fullscreen }
{ if FFullscreen then
if FFullscreen then
if FCursor then
Win32Cursor_resurrect
FWin32Cursor.Show
else
Win32Cursor_kill;}
FWin32Cursor.Hide;
end;
procedure TGDIConsole.Clear;
@ -334,6 +428,21 @@ function TGDIConsole.Option(const AOption: String): Boolean;
begin
LOG('console option', AOption);
Result := True;
if AOption = 'default output' then
begin
FFullscreen := False;
exit;
end;
if AOption = 'windowed output' then
begin
FFullscreen := False;
exit;
end;
if AOption = 'fullscreen output' then
begin
FFullscreen := True;
exit;
end;
if AOption = 'default cursor' then
begin
FCursorMode := CURSOR_DEFAULT;
@ -354,12 +463,16 @@ begin
end;
if AOption = 'grab mouse' then
begin
FWindow.ConfineCursor(true);
if FOpen and (not FFullscreen) then
FWindow.ConfineCursor(True);
FGrabMouse := True;
exit;
end;
if AOption = 'ungrab mouse' then
begin
FWindow.ConfineCursor(false);
if FOpen and (not FFullscreen) then
FWindow.ConfineCursor(False);
FGrabMouse := False;
exit;
end;
@ -539,6 +652,58 @@ begin
Result := ''; // todo...
end;
function TGDIConsole.GetOpenGL_Enabled: Boolean;
begin
Result := FUseOpenGL;
end;
procedure TGDIConsole.SetOpenGL_Enabled(AValue: Boolean);
begin
if FOpen then
raise TPTCError.Create('Value of UseOpenGL cannot be modified while the console is open');
FUseOpenGL := AValue;
end;
procedure TGDIConsole.OpenGL_SwapBuffers;
begin
SwapBuffers(wglGetCurrentDC);
end;
procedure TGDIConsole.OpenGL_SetSwapInterval(AInterval: Integer);
begin
LOG('SetSwapInterval(' + IntToStr(AInterval) + ')');
if AInterval < 0 then
raise TPTCError.Create('Invalid swap interval');
LOG('checking if WGL_EXT_swap_control is supported');
if Load_WGL_EXT_swap_control then
begin
LOG('using WGL_EXT_swap_control');
LOG('wglSwapIntervalEXT(' + IntToStr(AInterval) + ')');
if not wglSwapIntervalEXT(AInterval) then
LOG('wglSwapIntervalEXT failed');
end
else
LOG('no supported extensions found for setting the swap interval');
end;
function TGDIConsole.OpenGL_GetSwapInterval: Integer;
begin
LOG('GetSwapInterval');
LOG('checking if WGL_EXT_swap_control is supported');
if Load_WGL_EXT_swap_control then
begin
LOG('using WGL_EXT_swap_control');
LOG('wglGetSwapIntervalEXT()');
Result := wglGetSwapIntervalEXT();
LOG('wglGetSwapIntervalEXT() result', Result);
end
else
begin
LOG('no supported extensions found for setting the swap interval, assuming the swap interval is 0');
Result := 0;
end;
end;
procedure TGDIConsole.CheckOpen(const AMessage: String);
begin
if not FOpen then

55
packages/ptc/src/win32/gdi/gdihookd.inc Normal file
View File

@ -0,0 +1,55 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2012 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
TGDIConsole = class;
TGDIHook = class(TWin32Hook)
private
{ console }
FCursor: Boolean;
FManaged: Boolean;
FFullscreen: Boolean;
FConsole: TGDIConsole;
protected
{ window procedure }
function WndProc(hWnd: HWND; message: DWord; wParam: WPARAM; lParam: LPARAM): LRESULT; override;
{ window management }
procedure Activate;
procedure Deactivate;
public
{ setup }
constructor Create(AConsole: TGDIConsole; AWindow: HWND; AThread: DWord; ACursor, AManaged, AFullscreen: Boolean);
destructor Destroy; override;
{ cursor management }
procedure Cursor(AFlag: Boolean);
end;

214
packages/ptc/src/win32/gdi/gdihooki.inc Normal file
View File

@ -0,0 +1,214 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2012 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
}
constructor TGDIHook.Create(AConsole: TGDIConsole; AWindow: HWND; AThread: DWord; ACursor, AManaged, AFullscreen: Boolean);
begin
FConsole := AConsole;
FCursor := ACursor;
FManaged := AManaged;
FFullscreen := AFullscreen;
LOG('creating window hook');
inherited Create(AWindow, AThread);
end;
destructor TGDIHook.Destroy;
begin
LOG('destroying window hook');
inherited Destroy;
end;
procedure TGDIHook.Cursor(AFlag: Boolean);
begin
FCursor := AFlag;
end;
function TGDIHook.WndProc(hWnd: HWND; message: DWord; wParam: WPARAM; lParam: LPARAM): LRESULT;
function WMSizeWParam2String(wParam: WPARAM): string;
begin
case wParam of
SIZE_MAXHIDE: Result := 'SIZE_MAXHIDE';
SIZE_MAXIMIZED: Result := 'SIZE_MAXIMIZED';
SIZE_MAXSHOW: Result := 'SIZE_MAXSHOW';
SIZE_MINIMIZED: Result := 'SIZE_MINIMIZED';
SIZE_RESTORED: Result := 'SIZE_RESTORED';
else
Result := 'Unknown (' + IntToStr(wParam) + ')';
end;
end;
var
active: Boolean;
thread: DWord;
console: TGDIConsole;
begin
case message of
WM_PAINT: begin
LOG('TGDIHook WM_PAINT');
{ paint console }
//FConsole.Paint;
end;
WM_ACTIVATEAPP: begin
LOG('TGDIHook WM_ACTIVATEAPP');
{ get window message data }
active := wParam <> 0;
thread := DWord(lParam);
{ check active flag }
if active = False then
begin
if FConsole.FGrabMouse and (not FFullscreen) then
FConsole.FWindow.ConfineCursor(False);
if FFullscreen then
ShowWindow(FWindow, SW_MINIMIZE);
end
else
begin
if FConsole.FGrabMouse and (not FFullscreen) then
FConsole.FWindow.ConfineCursor(True);
end;
end;
WM_SIZE:
begin
LOG('TGDIHook WM_SIZE, wParam = ' + WMSizeWParam2String(wParam));
case wParam of
SIZE_MINIMIZED:
begin
Deactivate;
end;
SIZE_RESTORED, SIZE_MAXIMIZED:
begin
Activate;
end;
end;
{ pass to the next handler (or DefWindowProc) }
Result := 0;
exit;
end;
WM_SETCURSOR: begin
{ check cursor }
if not FCursor then
begin
if FFullscreen or (LOWORD(lParam) = HTCLIENT) then
begin
{ hide cursor }
SetCursor(0);
{ handled }
Result := 1;
end;
end;
end;
WM_CLOSE: begin
LOG('TGDIHook WM_CLOSE');
if FManaged then
begin
console := FConsole;
{ close console }
console.Close;
{ note: at this point the hook object has been destroyed by the console! }
{ internal console shutdown }
//console.internal_shutdown;
{ halt }
Halt(0);
end;
{ handled }
Result := 1;
exit;
end;
end;
{ unhandled }
Result := 0;
end;
procedure TGDIHook.Activate;
var
// placement: WINDOWPLACEMENT;
ModeSetter: TWin32ModeSetter;
begin
LOG('activate');
if FConsole.FOpen then
begin
if FFullscreen then
begin
ModeSetter := FConsole.FModeSetter;
if not ModeSetter.InMode then
begin
ModeSetter.Save;
ModeSetter.Enter;
end;
if not FCursor then
FConsole.FWin32Cursor.Hide;
end;
end;
end;
procedure TGDIHook.Deactivate;
var
ModeSetter: TWin32ModeSetter;
begin
LOG('deactivate');
if FConsole.FOpen then
begin
if FFullscreen then
begin
if not FCursor then
FConsole.FWin32Cursor.Show;
ModeSetter := FConsole.FModeSetter;
if ModeSetter.InMode then
begin
ModeSetter.Leave;
ModeSetter.Restore;
end;
end;
end;
end;

2
packages/ptc/src/win32/gdi/win32dibd.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2011 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

2
packages/ptc/src/win32/gdi/win32dibi.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
Copyright (C) 2001-2011 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

56
packages/ptc/src/win32/gdi/win32modesetterd.inc Normal file
View File

@ -0,0 +1,56 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2012 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
TWin32ModeSetter = class
private
FInMode: Boolean;
FOpen: Boolean;
FModes: array of IPTCMode;
FChosenMode: TDEVMODE;
procedure SetupModeList;
procedure DispChangeCheck(ADispChangeResult: LONG);
procedure LogDevMode(const ADevMode: TDEVMODE);
public
constructor Create;
procedure Open(AWidth, AHeight: Integer; AFormat: IPTCFormat);
procedure Close;
procedure Save;
procedure Restore;
procedure Enter;
procedure Leave;
property InMode: Boolean read FInMode;
property IsOpen: Boolean read FOpen;
end;

288
packages/ptc/src/win32/gdi/win32modesetteri.inc Normal file
View File

@ -0,0 +1,288 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2012 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
}
{$WARNING add these to windows unit}
const
DISP_CHANGE_BADPARAM = -5;
DISP_CHANGE_BADDUALVIEW = -6;
DM_POSITION = $00000020;
DM_NUP = $00000040;
DM_PANNINGWIDTH = $08000000;
DM_PANNINGHEIGHT = $10000000;
DMDFO_DEFAULT = 0;
DMDFO_STRETCH = 1;
DMDFO_CENTER = 2;
constructor TWin32ModeSetter.Create;
begin
SetupModeList;
end;
procedure TWin32ModeSetter.Open(AWidth, AHeight: Integer; AFormat: IPTCFormat);
var
dm: TDEVMODE;
begin
FillChar(dm, SizeOf(dm), 0);
dm.dmSize := SizeOf(dm);
dm.dmPelsWidth := AWidth;
dm.dmPelsHeight := AHeight;
dm.dmBitsPerPel := AFormat.Bits;
dm.dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
DispChangeCheck(ChangeDisplaySettings(@dm, CDS_FULLSCREEN));
FillChar(FChosenMode, SizeOf(FChosenMode), 0);
FChosenMode.dmSize := SizeOf(FChosenMode);
FChosenMode.dmDriverExtra := 0;
if not EnumDisplaySettings(nil, ENUM_CURRENT_SETTINGS, @FChosenMode) then
raise TPTCError.Create('EnumDisplaySettings(ENUM_CURRENT_SETTINGS) failed after mode set');
FInMode := True;
FOpen := True;
end;
procedure TWin32ModeSetter.Close;
begin
FOpen := False;
if not FInMode then
exit;
DispChangeCheck(ChangeDisplaySettings(nil, 0));
FInMode := False;
end;
procedure TWin32ModeSetter.Save;
begin
LOG('saving desktop');
end;
procedure TWin32ModeSetter.Restore;
begin
LOG('restoring desktop');
end;
procedure TWin32ModeSetter.Enter;
begin
LOG('entering mode');
if not FInMode then
begin
DispChangeCheck(ChangeDisplaySettings(@FChosenMode, CDS_FULLSCREEN));
FInMode := True;
end;
end;
procedure TWin32ModeSetter.Leave;
begin
LOG('leaving mode');
if FInMode then
begin
DispChangeCheck(ChangeDisplaySettings(nil, 0));
FInMode := False;
end;
end;
procedure TWin32ModeSetter.SetupModeList;
var
dm: TDEVMODE;
I: Integer;
ModeExists: Boolean;
begin
LOG('getting list of display modes');
SetLength(FModes, 0);
I := 0;
repeat
FillChar(dm, SizeOf(dm), 0);
dm.dmSize := SizeOf(dm);
dm.dmDriverExtra := 0;
ModeExists := EnumDisplaySettings(nil, I, @dm);
if ModeExists then
begin
LogDevMode(dm);
LOG(IntToStr(dm.dmPelsWidth) + 'x' + IntToStr(dm.dmPelsHeight) + 'x' + IntToStr(dm.dmBitsPerPel) + ' ' + IntToStr(dm.dmDisplayFrequency) + ' Hz');
{todo: add to FModes list...}
Inc(I);
end;
until not ModeExists;
LOG('done getting the list of modes');
end;
procedure TWin32ModeSetter.DispChangeCheck(ADispChangeResult: LONG);
function DispChangeResult2String(ADispChangeResult: LONG): string;
begin
case ADispChangeResult of
DISP_CHANGE_SUCCESSFUL: Result := 'DISP_CHANGE_SUCCESSFUL';
DISP_CHANGE_BADDUALVIEW: Result := 'DISP_CHANGE_BADDUALVIEW';
DISP_CHANGE_BADFLAGS: Result := 'DISP_CHANGE_BADFLAGS';
DISP_CHANGE_BADMODE: Result := 'DISP_CHANGE_BADMODE';
DISP_CHANGE_BADPARAM: Result := 'DISP_CHANGE_BADPARAM';
DISP_CHANGE_FAILED: Result := 'DISP_CHANGE_FAILED';
DISP_CHANGE_NOTUPDATED: Result := 'DISP_CHANGE_NOTUPDATED';
DISP_CHANGE_RESTART: Result := 'DISP_CHANGE_RESTART';
else
Result := 'Unknown';
end;
Result := IntToStr(ADispChangeResult) + ' (' + Result + ')';
end;
begin
if ADispChangeResult <> DISP_CHANGE_SUCCESSFUL then
raise TPTCError.Create('Error setting display mode; ChangeDisplaySettings returned ' + DispChangeResult2String(ADispChangeResult));
end;
procedure TWin32ModeSetter.LogDevMode(const ADevMode: TDEVMODE);
function Fields2String(dmFields: DWORD): string;
begin
Result := '';
if (dmFields and DM_ORIENTATION) <> 0 then
Result := Result + 'DM_ORIENTATION + ';
if (dmFields and DM_PAPERSIZE) <> 0 then
Result := Result + 'DM_PAPERSIZE + ';
if (dmFields and DM_PAPERLENGTH) <> 0 then
Result := Result + 'DM_PAPERLENGTH + ';
if (dmFields and DM_PAPERWIDTH) <> 0 then
Result := Result + 'DM_PAPERWIDTH + ';
if (dmFields and DM_SCALE) <> 0 then
Result := Result + 'DM_SCALE + ';
if (dmFields and DM_COPIES) <> 0 then
Result := Result + 'DM_COPIES + ';
if (dmFields and DM_DEFAULTSOURCE) <> 0 then
Result := Result + 'DM_DEFAULTSOURCE + ';
if (dmFields and DM_PRINTQUALITY) <> 0 then
Result := Result + 'DM_PRINTQUALITY + ';
if (dmFields and DM_POSITION) <> 0 then
Result := Result + 'DM_POSITION + ';
if (dmFields and DM_DISPLAYORIENTATION) <> 0 then
Result := Result + 'DM_DISPLAYORIENTATION + ';
if (dmFields and DM_DISPLAYFIXEDOUTPUT) <> 0 then
Result := Result + 'DM_DISPLAYFIXEDOUTPUT + ';
if (dmFields and DM_COLOR) <> 0 then
Result := Result + 'DM_COLOR + ';
if (dmFields and DM_DUPLEX) <> 0 then
Result := Result + 'DM_DUPLEX + ';
if (dmFields and DM_YRESOLUTION) <> 0 then
Result := Result + 'DM_YRESOLUTION + ';
if (dmFields and DM_TTOPTION) <> 0 then
Result := Result + 'DM_TTOPTION + ';
if (dmFields and DM_COLLATE) <> 0 then
Result := Result + 'DM_COLLATE + ';
if (dmFields and DM_FORMNAME) <> 0 then
Result := Result + 'DM_FORMNAME + ';
if (dmFields and DM_LOGPIXELS) <> 0 then
Result := Result + 'DM_LOGPIXELS + ';
if (dmFields and DM_BITSPERPEL) <> 0 then
Result := Result + 'DM_BITSPERPEL + ';
if (dmFields and DM_PELSWIDTH) <> 0 then
Result := Result + 'DM_PELSWIDTH + ';
if (dmFields and DM_PELSHEIGHT) <> 0 then
Result := Result + 'DM_PELSHEIGHT + ';
if (dmFields and DM_DISPLAYFLAGS) <> 0 then
Result := Result + 'DM_DISPLAYFLAGS + ';
if (dmFields and DM_NUP) <> 0 then
Result := Result + 'DM_NUP + ';
if (dmFields and DM_DISPLAYFREQUENCY) <> 0 then
Result := Result + 'DM_DISPLAYFREQUENCY + ';
if (dmFields and DM_ICMMETHOD) <> 0 then
Result := Result + 'DM_ICMMETHOD + ';
if (dmFields and DM_ICMINTENT) <> 0 then
Result := Result + 'DM_ICMINTENT + ';
if (dmFields and DM_MEDIATYPE) <> 0 then
Result := Result + 'DM_MEDIATYPE + ';
if (dmFields and DM_DITHERTYPE) <> 0 then
Result := Result + 'DM_DITHERTYPE + ';
if (dmFields and DM_PANNINGWIDTH) <> 0 then
Result := Result + 'DM_PANNINGWIDTH + ';
if (dmFields and DM_PANNINGHEIGHT) <> 0 then
Result := Result + 'DM_PANNINGHEIGHT + ';
if Length(Result) > 0 then
Result := Copy(Result, 1, Length(Result) - 3);
Result := IntToStr(dmFields) + ' (' + Result + ')';
end;
function DisplayOrientation2String(dmDisplayOrientation: DWORD): string;
begin
case dmDisplayOrientation of
DMDO_DEFAULT: Result := 'DMDO_DEFAULT';
DMDO_90: Result := 'DMDO_90';
DMDO_180: Result := 'DMDO_180';
DMDO_270: Result := 'DMDO_270';
else
Result := 'Unknown';
end;
Result := IntToStr(dmDisplayOrientation) + ' (' + Result + ')';
end;
function DisplayFixedOutput2String(dmDisplayFixedOutput: DWORD): string;
begin
case dmDisplayFixedOutput of
DMDFO_DEFAULT: Result := 'DMDFO_DEFAULT';
DMDFO_CENTER: Result := 'DMDFO_CENTER';
DMDFO_STRETCH: Result := 'DMDFO_STRETCH';
else
Result := 'Unknown';
end;
Result := IntToStr(dmDisplayFixedOutput) + ' (' + Result + ')';
end;
function DisplayFlags2String(dmDisplayFlags: DWORD): string;
begin
Result := '';
if (dmDisplayFlags and DM_GRAYSCALE) <> 0 then
Result := Result + 'DM_GRAYSCALE + ';
if (dmDisplayFlags and DM_INTERLACED) <> 0 then
Result := Result + 'DM_INTERLACED + ';
if Length(Result) > 0 then
Result := Copy(Result, 1, Length(Result) - 3);
Result := IntToStr(dmDisplayFlags) + ' (' + Result + ')';
end;
begin
LOG('dmFields', Fields2String(ADevMode.dmFields));
if (ADevMode.dmFields and DM_DISPLAYORIENTATION) <> 0 then
LOG('dmDisplayOrientation', DisplayOrientation2String(ADevMode.dmDisplayOrientation));
if (ADevMode.dmFields and DM_DISPLAYFIXEDOUTPUT) <> 0 then
LOG('dmDisplayFixedOutput', DisplayFixedOutput2String(ADevMode.dmDisplayFixedOutput));
if (ADevMode.dmFields and DM_BITSPERPEL) <> 0 then
LOG('dmBitsPerPel ', ADevMode.dmBitsPerPel);
if (ADevMode.dmFields and DM_PELSWIDTH) <> 0 then
LOG('dmPelsWidth ', ADevMode.dmPelsWidth);
if (ADevMode.dmFields and DM_PELSHEIGHT) <> 0 then
LOG('dmPelsHeight ', ADevMode.dmPelsHeight);
if (ADevMode.dmFields and DM_DISPLAYFLAGS) <> 0 then
LOG('dmDisplayFlags ', DisplayFlags2String(ADevMode.dmDisplayFlags));
if (ADevMode.dmFields and DM_DISPLAYFREQUENCY) <> 0 then
LOG('dmDisplayFrequency ', IntToStr(ADevMode.dmDisplayFrequency) + ' Hz');
end;

49
packages/ptc/src/win32/gdi/win32openglwindowd.inc Normal file
View File

@ -0,0 +1,49 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2012 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
TWin32OpenGLWindow = class(TWin32Window)
private
FPixelFormatDescriptor: PIXELFORMATDESCRIPTOR;
FChosenPixelFormatDescriptor: PIXELFORMATDESCRIPTOR;
procedure SetOpenGLAttributes(const AOpenGLAttributes: IPTCOpenGLAttributes);
function EnumerateAllPixelFormats(hdc: HDC): Boolean;
function SetupOpenGLPixelFormat(hdc: HDC): Boolean;
procedure LogPixelFormatDescriptor(const pfd: PIXELFORMATDESCRIPTOR);
protected
function WMCreate(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; override;
function WMDestroy(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; override;
public
constructor Create(const AWndClass, ATitle: string; AExtra, AStyle, AClassStyle: DWord;
AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded,
ACursor: Boolean; const AOpenGLAttributes: IPTCOpenGLAttributes);
end;

358
packages/ptc/src/win32/gdi/win32openglwindowi.inc Normal file
View File

@ -0,0 +1,358 @@
{
This file is part of the PTCPas framebuffer library
Copyright (C) 2012 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
}
{$WARNING add these to the windows unit}
const
PFD_DIRECT3D_ACCELERATED = $00004000;
PFD_SUPPORT_COMPOSITION = $00008000;
constructor TWin32OpenGLWindow.Create(const AWndClass, ATitle: string; AExtra, AStyle, AClassStyle: DWord;
AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded, ACursor: Boolean;
const AOpenGLAttributes: IPTCOpenGLAttributes);
begin
SetOpenGLAttributes(AOpenGLAttributes);
inherited Create(AWndClass, ATitle, AExtra, AStyle, AClassStyle,
AShow, AX, AY, AWidth, AHeight, ACenter, AMultithreaded, ACursor);
end;
function TWin32OpenGLWindow.WMCreate(
hWnd: HWND;
uMsg: UINT;
wParam: WPARAM;
lParam: LPARAM): LRESULT;
var
dc: HDC;
Context: HGLRC;
begin
LOG('inside OpenGL WM_CREATE handler');
LOG('getting device context');
dc := GetDC(hWnd);
if dc = 0 then
begin
LOG('GetDC returned an error, failing WM_CREATE');
exit(-1);
end;
{$IFDEF DEBUG}
LOG('enumerating all pixel formats available on this device context');
if not EnumerateAllPixelFormats(dc) then
begin
LOG('error enumerating pixel formats, failing WM_CREATE');
LOG('ReleaseDC');
if ReleaseDC(hWnd, dc) = 0 then
LOG('ReleaseDC failed');
exit(-1);
end;
{$ENDIF DEBUG}
LOG('setting up OpenGL pixel format');
if not Self.SetupOpenGLPixelFormat(dc) then
begin
LOG('error setting up OpenGL pixel format, failing WM_CREATE');
LOG('ReleaseDC');
if ReleaseDC(hWnd, dc) = 0 then
LOG('ReleaseDC failed');
exit(-1);
end;
LOG('creating OpenGL rendering context');
Context := wglCreateContext(dc);
if Context = 0 then
begin
LOG('error creating OpenGL rendering context, failing WM_CREATE');
LOG('ReleaseDC');
if ReleaseDC(hWnd, dc) = 0 then
LOG('ReleaseDC failed');
exit(-1);
end;
LOG('making it current');
if not wglMakeCurrent(dc, Context) then
begin
LOG('error making the OpenGL rendering context current, failing WM_CREATE');
LOG('ReleaseDC');
if ReleaseDC(hWnd, dc) = 0 then
LOG('ReleaseDC failed');
LOG('wglDeleteContext');
if not wglDeleteContext(Context) then
LOG('wglDeleteContext failed');
exit(-1);
end;
LOG('WM_CREATE success');
Result := 0;
end;
function TWin32OpenGLWindow.WMDestroy(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
dc: HDC;
Context: HGLRC;
begin
LOG('inside OpenGL WM_DESTROY handler');
Context := wglGetCurrentContext;
if Context <> 0 then
begin
dc := wglGetCurrentDC;
LOG('wglMakeCurrent(0, 0)');
if not wglMakeCurrent(0, 0) then
LOG('wglMakeCurrent(0, 0) failed');
if dc <> 0 then
begin
LOG('ReleaseDC');
if ReleaseDC(hWnd, dc) = 0 then
LOG('ReleaseDC failed');
end
else
LOG('no WGL device context to release');
LOG('wglDeleteContext');
if not wglDeleteContext(Context) then
LOG('wglDeleteContext failed');
end
else
LOG('no current context to cleanup');
LOG('WM_DESTROY done');
inherited;
end;
procedure TWin32OpenGLWindow.SetOpenGLAttributes(const AOpenGLAttributes: IPTCOpenGLAttributes);
var
Flags: DWORD;
begin
Flags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
if AOpenGLAttributes.DoubleBufferDontCare then
Flags := Flags or PFD_DOUBLEBUFFER_DONTCARE
else
if AOpenGLAttributes.DoubleBuffer then
Flags := Flags or PFD_DOUBLEBUFFER;
if AOpenGLAttributes.StereoDontCare then
Flags := Flags or PFD_STEREO_DONTCARE
else
if AOpenGLAttributes.Stereo then
Flags := Flags or PFD_STEREO;
FillChar(FPixelFormatDescriptor, SizeOf(FPixelFormatDescriptor), 0);
FPixelFormatDescriptor.nSize := SizeOf(FPixelFormatDescriptor);
FPixelFormatDescriptor.nVersion := 1;
FPixelFormatDescriptor.dwFlags := Flags;
FPixelFormatDescriptor.iPixelType := PFD_TYPE_RGBA;
FPixelFormatDescriptor.cColorBits := AOpenGLAttributes.BufferSize;
FPixelFormatDescriptor.cRedBits := 0;
FPixelFormatDescriptor.cRedShift := 0;
FPixelFormatDescriptor.cGreenBits := 0;
FPixelFormatDescriptor.cGreenShift := 0;
FPixelFormatDescriptor.cBlueBits := 0;
FPixelFormatDescriptor.cBlueShift := 0;
FPixelFormatDescriptor.cAlphaBits := 0;
FPixelFormatDescriptor.cAlphaShift := 0;
FPixelFormatDescriptor.cAccumBits := 0;
FPixelFormatDescriptor.cAccumRedBits := 0;
FPixelFormatDescriptor.cAccumGreenBits := 0;
FPixelFormatDescriptor.cAccumBlueBits := 0;
FPixelFormatDescriptor.cAccumAlphaBits := 0;
FPixelFormatDescriptor.cDepthBits := AOpenGLAttributes.DepthSize;
FPixelFormatDescriptor.cStencilBits := AOpenGLAttributes.StencilSize;
FPixelFormatDescriptor.cAuxBuffers := 0;
FPixelFormatDescriptor.iLayerType := PFD_MAIN_PLANE;
FPixelFormatDescriptor.bReserved := 0;
FPixelFormatDescriptor.dwLayerMask := 0;
FPixelFormatDescriptor.dwVisibleMask := 0;
FPixelFormatDescriptor.dwDamageMask := 0;
end;
function TWin32OpenGLWindow.EnumerateAllPixelFormats(hdc: HDC): Boolean;
var
pfd: PIXELFORMATDESCRIPTOR;
pf_index, pf_count: Integer;
begin
pf_count := DescribePixelFormat(hdc, 1, 0, nil);
if pf_count = 0 then
begin
LOG('DescribePixelFormat failed');
exit(False);
end;
LOG('pixel formats count', pf_count);
for pf_index := 1 to pf_count do
begin
FillChar(pfd, SizeOf(pfd), 0);
pfd.nSize := SizeOf(pfd);
LOG('describing pixel format ' + IntToStr(pf_index));
if DescribePixelFormat(hdc, pf_index, SizeOf(pfd), @pfd) = 0 then
begin
LOG('DescribePixelFormat failed');
exit(False);
end;
LogPixelFormatDescriptor(pfd);
end;
end;
function TWin32OpenGLWindow.SetupOpenGLPixelFormat(hdc: HDC): Boolean;
var
pf_index: Integer;
begin
LOG('calling ChoosePixelFormat with:');
LogPixelFormatDescriptor(FPixelFormatDescriptor);
pf_index := ChoosePixelFormat(hdc, FPixelFormatDescriptor);
if pf_index = 0 then
begin
LOG('ChoosePixelFormat failed');
exit(False);
end;
LOG('ChoosePixelFormat result', pf_index);
LOG('getting description');
if DescribePixelFormat(hdc, pf_index, SizeOf(FChosenPixelFormatDescriptor), @FChosenPixelFormatDescriptor) = 0 then
begin
LOG('DescribePixelFormat failed');
exit(False);
end;
LogPixelFormatDescriptor(FChosenPixelFormatDescriptor);
LOG('setting pixel format');
if not SetPixelFormat(hdc, pf_index, @FPixelFormatDescriptor) then
begin
LOG('SetPixelFormat failed');
exit(False);
end;
Result := True;
end;
procedure TWin32OpenGLWindow.LogPixelFormatDescriptor(const pfd: PIXELFORMATDESCRIPTOR);
function dwFlags2String(dwFlags: DWORD): string;
begin
Result := IntToStr(dwFlags) + ' (';
if (dwFlags and PFD_DOUBLEBUFFER) <> 0 then
Result := Result + 'PFD_DOUBLEBUFFER + ';
if (dwFlags and PFD_STEREO) <> 0 then
Result := Result + 'PFD_STEREO + ';
if (dwFlags and PFD_DRAW_TO_WINDOW) <> 0 then
Result := Result + 'PFD_DRAW_TO_WINDOW + ';
if (dwFlags and PFD_DRAW_TO_BITMAP) <> 0 then
Result := Result + 'PFD_DRAW_TO_BITMAP + ';
if (dwFlags and PFD_SUPPORT_GDI) <> 0 then
Result := Result + 'PFD_SUPPORT_GDI + ';
if (dwFlags and PFD_SUPPORT_OPENGL) <> 0 then
Result := Result + 'PFD_SUPPORT_OPENGL + ';
if (dwFlags and PFD_GENERIC_FORMAT) <> 0 then
Result := Result + 'PFD_GENERIC_FORMAT + ';
if (dwFlags and PFD_NEED_PALETTE) <> 0 then
Result := Result + 'PFD_NEED_PALETTE + ';
if (dwFlags and PFD_NEED_SYSTEM_PALETTE) <> 0 then
Result := Result + 'PFD_NEED_SYSTEM_PALETTE + ';
if (dwFlags and PFD_SWAP_EXCHANGE) <> 0 then
Result := Result + 'PFD_SWAP_EXCHANGE + ';
if (dwFlags and PFD_SWAP_COPY) <> 0 then
Result := Result + 'PFD_SWAP_COPY + ';
if (dwFlags and PFD_SWAP_LAYER_BUFFERS) <> 0 then
Result := Result + 'PFD_SWAP_LAYER_BUFFERS + ';
if (dwFlags and PFD_GENERIC_ACCELERATED) <> 0 then
Result := Result + 'PFD_GENERIC_ACCELERATED + ';
if (dwFlags and PFD_SUPPORT_DIRECTDRAW) <> 0 then
Result := Result + 'PFD_SUPPORT_DIRECTDRAW + ';
if (dwFlags and PFD_DIRECT3D_ACCELERATED) <> 0 then
Result := Result + 'PFD_DIRECT3D_ACCELERATED + ';
if (dwFlags and PFD_SUPPORT_COMPOSITION) <> 0 then
Result := Result + 'PFD_SUPPORT_COMPOSITION + ';
if (dwFlags and PFD_DEPTH_DONTCARE) <> 0 then
Result := Result + 'PFD_DEPTH_DONTCARE + ';
if (dwFlags and PFD_DOUBLEBUFFER_DONTCARE) <> 0 then
Result := Result + 'PFD_DOUBLEBUFFER_DONTCARE + ';
if (dwFlags and PFD_STEREO_DONTCARE) <> 0 then
Result := Result + 'PFD_STEREO_DONTCARE + ';
if Copy(Result, Length(Result) - 2, 3) = ' + ' then
Result := Copy(Result, 1, Length(Result) - 3);
Result := Result + ')';
end;
function iPixelType2String(iPixelType: Byte): string;
begin
case iPixelType of
PFD_TYPE_RGBA: Result := 'PFD_TYPE_RGBA';
PFD_TYPE_COLORINDEX: Result := 'PFD_TYPE_COLORINDEX';
else
Result := 'Unknown';
end;
Result := IntToStr(iPixelType) + ' (' + Result + ')';
end;
function iLayerType2String(iLayerType: Byte): string;
begin
case iLayerType of
PFD_MAIN_PLANE: Result := 'PFD_MAIN_PLANE';
PFD_OVERLAY_PLANE: Result := 'PFD_OVERLAY_PLANE';
Byte(PFD_UNDERLAY_PLANE): Result := 'PFD_UNDERLAY_PLANE';
else
Result := 'Unknown';
end;
Result := IntToStr(iLayerType) + ' (' + Result + ')';
end;
begin
LOG('PIXELFORMATDESCRIPTOR:');
LOG('nSize ', pfd.nSize);
LOG('nVersion ', pfd.nVersion);
LOG('dwFlags ', dwFlags2String(pfd.dwFlags));
LOG('iPixelType ', iPixelType2String(pfd.iPixelType));
LOG('cColorBits ', pfd.cColorBits);
LOG('cRedBits ', pfd.cRedBits);
LOG('cRedShift ', pfd.cRedShift);
LOG('cGreenBits ', pfd.cGreenBits);
LOG('cGreenShift ', pfd.cGreenShift);
LOG('cBlueBits ', pfd.cBlueBits);
LOG('cBlueShift ', pfd.cBlueShift);
LOG('cAlphaBits ', pfd.cAlphaBits);
LOG('cAlphaShift ', pfd.cAlphaShift);
LOG('cAccumBits ', pfd.cAccumBits);
LOG('cAccumRedBits ', pfd.cAccumRedBits);
LOG('cAccumGreenBits', pfd.cAccumGreenBits);
LOG('cAccumBlueBits ', pfd.cAccumBlueBits);
LOG('cAccumAlphaBits', pfd.cAccumAlphaBits);
LOG('cDepthBits ', pfd.cDepthBits);
LOG('cStencilBits ', pfd.cStencilBits);
LOG('cAuxBuffers ', pfd.cAuxBuffers);
LOG('iLayerType ', iLayerType2String(pfd.iLayerType));
LOG('bReserved ', pfd.bReserved);
LOG('dwLayerMask ', pfd.dwLayerMask);
LOG('dwVisibleMask ', pfd.dwVisibleMask);
LOG('dwDamageMask ', pfd.dwDamageMask);
end;

Some files were not shown because too many files have changed in this diff Show More