1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-21 16:55:01 -05:00

Litlee IFDEF

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@2 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-08-28 22:29:18 +00:00
parent 18419b36cc
commit 53f343d58e

View File

@ -1,172 +1,174 @@
unit Window; unit Window;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, mufasatypes Classes, SysUtils, mufasatypes
{$IFDEF LINUX}, xlib, x, xutil, ctypes{$ENDIF}; {$IFDEF LINUX}, xlib, x, xutil, ctypes{$ENDIF};
type type
TMWindow = class(TObject) TMWindow = class(TObject)
function ReturnData(xs, ys, width, height: Integer): PRGB32; function ReturnData(xs, ys, width, height: Integer): PRGB32;
procedure FreeReturnData; procedure FreeReturnData;
procedure GetDimensions(var W, H: Integer); procedure GetDimensions(var W, H: Integer);
constructor Create(Client: TObject); constructor Create(Client: TObject);
destructor Destroy; override; destructor Destroy; override;
protected protected
// Reference to client. // Reference to client.
Client: TObject; Client: TObject;
// Target Window Mode. // Target Window Mode.
TargetMode: TTargetWindowMode; TargetMode: TTargetWindowMode;
{$IFDEF LINUX} {$IFDEF LINUX}
// X Display // X Display
XDisplay: PDisplay; XDisplay: PDisplay;
// Connection Number // Connection Number
XConnectionNumber: Integer; XConnectionNumber: Integer;
// X Window // X Window
CurWindow: QWord; CurWindow: QWord;
// Desktop Window // Desktop Window
DesktopWindow: QWord; DesktopWindow: QWord;
// X Screen // X Screen
XScreen: PScreen; XScreen: PScreen;
// X Screen Number // X Screen Number
XScreenNum: Integer; XScreenNum: Integer;
// The X Image pointer. // The X Image pointer.
XWindowImage: PXImage; XWindowImage: PXImage;
{$IFDEF M_MEMORY_DEBUG} {$IFDEF M_MEMORY_DEBUG}
// XImageFreed should be True if there is currently no // XImageFreed should be True if there is currently no
// XImage loaded. If one is loaded, XImageFreed is true. // XImage loaded. If one is loaded, XImageFreed is true.
// If ReturnData is called while XImageFreed is false, // If ReturnData is called while XImageFreed is false,
// we throw an exception. // we throw an exception.
// Same for FreeReturnData with XImageFreed true. // Same for FreeReturnData with XImageFreed true.
XImageFreed: Boolean; XImageFreed: Boolean;
{$ENDIF} {$ENDIF}
{$ELSE} {$ELSE}
{$ENDIF} {$ENDIF}
end; end;
implementation implementation
uses uses
Client; Client;
constructor TMWindow.Create(Client: TObject); constructor TMWindow.Create(Client: TObject);
begin begin
inherited Create; inherited Create;
Self.Client := Client; Self.Client := Client;
{$IFDEF LINUX} {$IFDEF LINUX}
Self.TargetMode := w_XWindow; Self.TargetMode := w_XWindow;
Self.XDisplay := XOpenDisplay(nil); Self.XDisplay := XOpenDisplay(nil);
if Self.XDisplay = nil then if Self.XDisplay = nil then
begin begin
// throw Exception // throw Exception
end; end;
Self.XConnectionNumber:= ConnectionNumber(Self.XDisplay); Self.XConnectionNumber:= ConnectionNumber(Self.XDisplay);
Self.XScreen := XDefaultScreenOfDisplay(Self.XDisplay); Self.XScreen := XDefaultScreenOfDisplay(Self.XDisplay);
Self.XScreenNum:= DefaultScreen(Self.XDisplay); Self.XScreenNum:= DefaultScreen(Self.XDisplay);
Self.DesktopWindow:= RootWindow(Self.XDisplay, Self.XScreenNum); Self.DesktopWindow:= RootWindow(Self.XDisplay, Self.XScreenNum);
Self.CurWindow:= Self.DesktopWindow; Self.CurWindow:= Self.DesktopWindow;
{$ELSE} {$ELSE}
// Set Target mode for windows. // Set Target mode for windows.
{$ENDIF} {$ENDIF}
end; end;
destructor TMWindow.Destroy; destructor TMWindow.Destroy;
begin begin
{$IFDEF LINUX} {$IFDEF LINUX}
XCloseDisplay(Self.XDisplay); XCloseDisplay(Self.XDisplay);
{$ENDIF} {$ENDIF}
inherited; inherited;
end; end;
function TMWindow.ReturnData(xs, ys, width, height: Integer): PRGB32; function TMWindow.ReturnData(xs, ys, width, height: Integer): PRGB32;
begin begin
end; end;
procedure TMWindow.FreeReturnData; procedure TMWindow.FreeReturnData;
begin begin
end; end;
// Too global. // Too global.
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl; {$IFDEF LINUX}
begin; function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
result := 0; begin;
Writeln('X Error: '); result := 0;
writeln('Error code: ' + inttostr(para2^.error_code)); Writeln('X Error: ');
writeln('Display: ' + inttostr(LongWord(para2^.display))); writeln('Error code: ' + inttostr(para2^.error_code));
writeln('Minor code: ' + inttostr(para2^.minor_code)); writeln('Display: ' + inttostr(LongWord(para2^.display)));
writeln('Request code: ' + inttostr(para2^.request_code)); writeln('Minor code: ' + inttostr(para2^.minor_code));
writeln('Resource ID: ' + inttostr(para2^.resourceid)); writeln('Request code: ' + inttostr(para2^.request_code));
writeln('Serial: ' + inttostr(para2^.serial)); writeln('Resource ID: ' + inttostr(para2^.resourceid));
writeln('Type: ' + inttostr(para2^._type)); writeln('Serial: ' + inttostr(para2^.serial));
end; writeln('Type: ' + inttostr(para2^._type));
end;
procedure TMWindow.GetDimensions(var W, H: Integer); {$ENDIF}
{$IFDEF LINUX}
var procedure TMWindow.GetDimensions(var W, H: Integer);
Attrib: TXWindowAttributes; {$IFDEF LINUX}
newx,newy : integer; var
childwindow : x.TWindow; Attrib: TXWindowAttributes;
Old_Handler: TXErrorHandler; newx,newy : integer;
{$ENDIF} childwindow : x.TWindow;
begin Old_Handler: TXErrorHandler;
case TargetMode of {$ENDIF}
w_Window: begin
begin case TargetMode of
end; w_Window:
w_XWindow: begin
begin end;
{$IFDEF LINUX} w_XWindow:
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); begin
if XGetWindowAttributes(Self.XDisplay, Self.CurWindow, @Attrib) <> 0 Then {$IFDEF LINUX}
begin Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
XTranslateCoordinates(Self.XDisplay, Self.CurWindow, self.DesktopWindow, 0,0,@newx,@newy, @childwindow); if XGetWindowAttributes(Self.XDisplay, Self.CurWindow, @Attrib) <> 0 Then
W := Attrib.Width; begin
H := Attrib.Height; XTranslateCoordinates(Self.XDisplay, Self.CurWindow, self.DesktopWindow, 0,0,@newx,@newy, @childwindow);
end else W := Attrib.Width;
begin H := Attrib.Height;
W := -1; end else
H := -1; begin
end; W := -1;
XSetErrorHandler(Old_Handler); H := -1;
{$ELSE} end;
WriteLn('You dummy! How are you going to use w_XWindow on non Linux systems?'); XSetErrorHandler(Old_Handler);
{$ENDIF} {$ELSE}
End; WriteLn('You dummy! How are you going to use w_XWindow on non Linux systems?');
w_ArrayPtr: {$ENDIF}
begin End;
end; w_ArrayPtr:
end; begin
end; end;
end;
end;
end.
end.