mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-24 02:02:17 -05:00
Simba: Cleanups in several units.
os_windows probably _DOES_ _NOT_ compile yet.
This commit is contained in:
parent
d7d2491f60
commit
45b215efd9
@ -5,7 +5,7 @@ unit XTest;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, x, xutil, xlib, ctypes, XKB, xinput;
|
Classes, SysUtils, x, xlib, ctypes, xinput;
|
||||||
|
|
||||||
{ type
|
{ type
|
||||||
PXDevice = Pointer; // ^XDevice ? }
|
PXDevice = Pointer; // ^XDevice ? }
|
||||||
|
@ -31,8 +31,8 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, client, uPSComponent,uPSCompiler,
|
Classes, SysUtils, client, uPSComponent,uPSCompiler,
|
||||||
uPSRuntime,stdCtrls, uPSPreProcessor,MufasaTypes,MufasaBase, web,
|
uPSRuntime, uPSPreProcessor,MufasaTypes,MufasaBase, web,
|
||||||
bitmaps, plugins, libloader, dynlibs,internets,scriptproperties,
|
bitmaps, plugins, dynlibs,internets,scriptproperties,
|
||||||
settings,settingssandbox, lcltype, dialogs
|
settings,settingssandbox, lcltype, dialogs
|
||||||
{$IFDEF USE_RUTIS}
|
{$IFDEF USE_RUTIS}
|
||||||
,Rutis_Engine,Rutis_Defs
|
,Rutis_Engine,Rutis_Defs
|
||||||
@ -443,8 +443,7 @@ function TMThread.ProcessDirective(Sender: TPSPreProcessor;
|
|||||||
Parser: TPSPascalPreProcessorParser;
|
Parser: TPSPascalPreProcessorParser;
|
||||||
DirectiveName, DirectiveArgs: string; FileName: string): boolean;
|
DirectiveName, DirectiveArgs: string; FileName: string): boolean;
|
||||||
var
|
var
|
||||||
plugin_idx, i: integer;
|
plugin_idx: integer;
|
||||||
path : string;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
@ -988,8 +987,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
constructor TCPThread.Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
|
constructor TCPThread.Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
|
||||||
var
|
|
||||||
plugin_idx: integer;
|
|
||||||
begin
|
begin
|
||||||
inherited Create(CreateSuspended, TheSyncInfo, plugin_dir);
|
inherited Create(CreateSuspended, TheSyncInfo, plugin_dir);
|
||||||
if libcpascal = 0 then
|
if libcpascal = 0 then
|
||||||
|
@ -42,8 +42,8 @@ interface
|
|||||||
{ ONLY override some of the following methods if the target provides image functions, defaults
|
{ ONLY override some of the following methods if the target provides image functions, defaults
|
||||||
| to raise exceptions. GetColor provides default functionality using ReturData of width 1.
|
| to raise exceptions. GetColor provides default functionality using ReturData of width 1.
|
||||||
| FreeReturnData provides default of doing nothing. }
|
| FreeReturnData provides default of doing nothing. }
|
||||||
procedure GetTargetDimensions(var w, h: integer); virtual;
|
procedure GetTargetDimensions(out w, h: integer); virtual;
|
||||||
procedure GetTargetPosition(var left, top: integer); virtual;
|
procedure GetTargetPosition(out left, top: integer); virtual;
|
||||||
function GetColor(x,y : integer) : TColor; virtual;
|
function GetColor(x,y : integer) : TColor; virtual;
|
||||||
function ReturnData(xs, ys, width, height: Integer): TRetData; virtual;
|
function ReturnData(xs, ys, width, height: Integer): TRetData; virtual;
|
||||||
procedure FreeReturnData; virtual;
|
procedure FreeReturnData; virtual;
|
||||||
@ -57,7 +57,7 @@ interface
|
|||||||
|
|
||||||
{ ONLY override the following methods if the target provides mouse functions, defaults to
|
{ ONLY override the following methods if the target provides mouse functions, defaults to
|
||||||
| raise exceptions }
|
| raise exceptions }
|
||||||
procedure GetMousePosition(var x,y: integer); virtual;
|
procedure GetMousePosition(out x,y: integer); virtual;
|
||||||
procedure MoveMouse(x,y: integer); virtual;
|
procedure MoveMouse(x,y: integer); virtual;
|
||||||
procedure ScrollMouse(x,y : integer; Lines : integer); virtual;
|
procedure ScrollMouse(x,y : integer; Lines : integer); virtual;
|
||||||
procedure HoldMouse(x,y: integer; button: TClickType); virtual;
|
procedure HoldMouse(x,y: integer; button: TClickType); virtual;
|
||||||
@ -80,8 +80,8 @@ interface
|
|||||||
constructor Create(rgb: prgb32; w,h: integer; CopyData : boolean = false);
|
constructor Create(rgb: prgb32; w,h: integer; CopyData : boolean = false);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
|
||||||
procedure GetTargetDimensions(var w, h: integer); override;
|
procedure GetTargetDimensions(out w, h: integer); override;
|
||||||
procedure GetTargetPosition(var left, top: integer); override;
|
procedure GetTargetPosition(out left, top: integer); override;
|
||||||
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
||||||
|
|
||||||
protected
|
protected
|
||||||
@ -95,7 +95,7 @@ interface
|
|||||||
constructor Create(bitmap: TMufasaBitmap);
|
constructor Create(bitmap: TMufasaBitmap);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
|
||||||
procedure GetTargetDimensions(var w, h: integer); override;
|
procedure GetTargetDimensions(out w, h: integer); override;
|
||||||
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
||||||
|
|
||||||
protected
|
protected
|
||||||
@ -109,14 +109,14 @@ interface
|
|||||||
|
|
||||||
TWindow_Abstract = class(TTarget)
|
TWindow_Abstract = class(TTarget)
|
||||||
public
|
public
|
||||||
procedure GetTargetDimensions(var w, h: integer); override; abstract;
|
procedure GetTargetDimensions(out w, h: integer); override; abstract;
|
||||||
procedure GetTargetPosition(var left, top: integer); override; abstract;
|
procedure GetTargetPosition(out left, top: integer); override; abstract;
|
||||||
function ReturnData(xs, ys, width, height: Integer): TRetData; override; abstract;
|
function ReturnData(xs, ys, width, height: Integer): TRetData; override; abstract;
|
||||||
|
|
||||||
function TargetValid: boolean; override; abstract;
|
function TargetValid: boolean; override; abstract;
|
||||||
|
|
||||||
procedure ActivateClient; override; abstract;
|
procedure ActivateClient; override; abstract;
|
||||||
procedure GetMousePosition(var x,y: integer); override; abstract;
|
procedure GetMousePosition(out x,y: integer); override; abstract;
|
||||||
procedure MoveMouse(x,y: integer); override; abstract;
|
procedure MoveMouse(x,y: integer); override; abstract;
|
||||||
procedure ScrollMouse(x,y : integer; Lines : integer); override; abstract;
|
procedure ScrollMouse(x,y : integer; Lines : integer); override; abstract;
|
||||||
procedure HoldMouse(x,y: integer; button: TClickType); override; abstract;
|
procedure HoldMouse(x,y: integer; button: TClickType); override; abstract;
|
||||||
@ -172,11 +172,11 @@ interface
|
|||||||
constructor Create(client: TEIOS_Client; initval: pointer);
|
constructor Create(client: TEIOS_Client; initval: pointer);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
|
||||||
procedure GetTargetDimensions(var w, h: integer); override;
|
procedure GetTargetDimensions(out w, h: integer); override;
|
||||||
procedure GetTargetPosition(var left, top: integer); override;
|
procedure GetTargetPosition(out left, top: integer); override;
|
||||||
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
||||||
|
|
||||||
procedure GetMousePosition(var x,y: integer); override;
|
procedure GetMousePosition(out x,y: integer); override;
|
||||||
procedure MoveMouse(x,y: integer); override;
|
procedure MoveMouse(x,y: integer); override;
|
||||||
procedure ScrollMouse(x,y : integer; Lines : integer); override;
|
procedure ScrollMouse(x,y : integer; Lines : integer); override;
|
||||||
procedure HoldMouse(x,y: integer; button: TClickType); override;
|
procedure HoldMouse(x,y: integer; button: TClickType); override;
|
||||||
@ -283,7 +283,7 @@ interface
|
|||||||
function ReturnData(xs, ys, width, height: Integer): TRetData;
|
function ReturnData(xs, ys, width, height: Integer): TRetData;
|
||||||
procedure FreeReturnData;
|
procedure FreeReturnData;
|
||||||
|
|
||||||
procedure GetDimensions(var W, H: Integer);
|
procedure GetDimensions(out W, H: Integer);
|
||||||
procedure GetPosition(var Left, Top: Integer);
|
procedure GetPosition(var Left, Top: Integer);
|
||||||
procedure ActivateClient;
|
procedure ActivateClient;
|
||||||
|
|
||||||
@ -612,7 +612,7 @@ begin
|
|||||||
result := (keymouse.TargetValid and image.TargetValid);
|
result := (keymouse.TargetValid and image.TargetValid);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIOManager_Abstract.GetDimensions(var W, H: Integer);
|
procedure TIOManager_Abstract.GetDimensions(out W, H: Integer);
|
||||||
begin
|
begin
|
||||||
image.GetTargetDimensions(w,h)
|
image.GetTargetDimensions(w,h)
|
||||||
end;
|
end;
|
||||||
@ -721,12 +721,12 @@ end;
|
|||||||
|
|
||||||
//***implementation*** TTarget
|
//***implementation*** TTarget
|
||||||
|
|
||||||
procedure TTarget.GetTargetDimensions(var w, h: integer);
|
procedure TTarget.GetTargetDimensions(out w, h: integer);
|
||||||
begin
|
begin
|
||||||
raise Exception.Create('GetTargetDimensions not available for this target');
|
raise Exception.Create('GetTargetDimensions not available for this target');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTarget.GetTargetPosition(var left, top: integer);
|
procedure TTarget.GetTargetPosition(out left, top: integer);
|
||||||
begin
|
begin
|
||||||
raise Exception.Create('GetTargetDimensions not available for this target');
|
raise Exception.Create('GetTargetDimensions not available for this target');
|
||||||
end;
|
end;
|
||||||
@ -754,7 +754,7 @@ begin
|
|||||||
result:= true;
|
result:= true;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTarget.GetMousePosition(var x,y: integer);
|
procedure TTarget.GetMousePosition(out x,y: integer);
|
||||||
begin
|
begin
|
||||||
raise Exception.Create('GetMousePosition not available for this target');
|
raise Exception.Create('GetMousePosition not available for this target');
|
||||||
end;
|
end;
|
||||||
@ -823,7 +823,7 @@ destructor TEIOS_Target.Destroy; begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TEIOS_Target.GetTargetDimensions(var w, h: integer);
|
procedure TEIOS_Target.GetTargetDimensions(out w, h: integer);
|
||||||
begin
|
begin
|
||||||
if Pointer(client.GetTargetDimensions) <> nil then
|
if Pointer(client.GetTargetDimensions) <> nil then
|
||||||
client.GetTargetDimensions(target,w,h)
|
client.GetTargetDimensions(target,w,h)
|
||||||
@ -831,7 +831,7 @@ begin
|
|||||||
inherited GetTargetDimensions(w,h);
|
inherited GetTargetDimensions(w,h);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TEIOS_Target.GetTargetPosition(var left, top: integer);
|
procedure TEIOS_Target.GetTargetPosition(out left, top: integer);
|
||||||
begin
|
begin
|
||||||
if Pointer(client.GetTargetDimensions) <> nil then
|
if Pointer(client.GetTargetDimensions) <> nil then
|
||||||
client.GetTargetDimensions(target,left,top)
|
client.GetTargetDimensions(target,left,top)
|
||||||
@ -854,7 +854,7 @@ begin
|
|||||||
Inc(result.Ptr, ys * result.RowLen + xs);
|
Inc(result.Ptr, ys * result.RowLen + xs);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TEIOS_Target.GetMousePosition(var x,y: integer);
|
procedure TEIOS_Target.GetMousePosition(out x,y: integer);
|
||||||
begin
|
begin
|
||||||
if Pointer(client.GetMousePosition) <> nil then
|
if Pointer(client.GetMousePosition) <> nil then
|
||||||
client.GetMousePosition(target,x,y)
|
client.GetMousePosition(target,x,y)
|
||||||
@ -974,13 +974,13 @@ begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRawTarget.GetTargetDimensions(var w, h: integer);
|
procedure TRawTarget.GetTargetDimensions(out w, h: integer);
|
||||||
begin
|
begin
|
||||||
w:= self.w;
|
w:= self.w;
|
||||||
h:= self.h;
|
h:= self.h;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRawTarget.GetTargetPosition(var left, top: integer);
|
procedure TRawTarget.GetTargetPosition(out left, top: integer);
|
||||||
begin
|
begin
|
||||||
{ The RawTarget has no position on the screen }
|
{ The RawTarget has no position on the screen }
|
||||||
left := 0;
|
left := 0;
|
||||||
@ -1008,7 +1008,7 @@ begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TBitmapTarget.GetTargetDimensions(var w, h: integer);
|
procedure TBitmapTarget.GetTargetDimensions(out w, h: integer);
|
||||||
begin
|
begin
|
||||||
h:= bitmap.Height;
|
h:= bitmap.Height;
|
||||||
w:= bitmap.Width;
|
w:= bitmap.Width;
|
||||||
|
@ -37,7 +37,7 @@ interface
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
MufasaTypes,MufasaBase,FileUtil, strutils;
|
MufasaTypes,MufasaBase,FileUtil;
|
||||||
|
|
||||||
procedure TGenericLoader.AddPath(path: string);
|
procedure TGenericLoader.AddPath(path: string);
|
||||||
var
|
var
|
||||||
|
@ -3,10 +3,10 @@ unit mufasabase;
|
|||||||
{$mode objfpc}{$H+}
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
interface
|
interface
|
||||||
{$undefine mDebug}
|
{$undef mDebug}
|
||||||
|
|
||||||
uses
|
uses
|
||||||
files, Classes, SysUtils{$ifdef MSWindows},windows{$endif};
|
Classes, SysUtils{$ifdef MSWindows},windows{$endif};
|
||||||
|
|
||||||
procedure mDebugLn( s : string);overload;
|
procedure mDebugLn( s : string);overload;
|
||||||
procedure mDebugLn( s : string; f : array of const);overload;
|
procedure mDebugLn( s : string; f : array of const);overload;
|
||||||
|
@ -26,7 +26,7 @@ unit os_linux;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, mufasatypes, xlib, x, xutil, IOManager, XKeyInput, ctypes, xtest, keysym,
|
Classes, SysUtils, mufasatypes, xlib, x, xutil, IOManager, XKeyInput, ctypes, xtest,
|
||||||
syncobjs, mufasabase;
|
syncobjs, mufasabase;
|
||||||
|
|
||||||
type
|
type
|
||||||
@ -45,8 +45,8 @@ interface
|
|||||||
public
|
public
|
||||||
constructor Create(display: PDisplay; screennum: integer; window: x.TWindow);
|
constructor Create(display: PDisplay; screennum: integer; window: x.TWindow);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
procedure GetTargetDimensions(var w, h: integer); override;
|
procedure GetTargetDimensions(out w, h: integer); override;
|
||||||
procedure GetTargetPosition(var left, top: integer); override;
|
procedure GetTargetPosition(out left, top: integer); override;
|
||||||
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
||||||
procedure FreeReturnData; override;
|
procedure FreeReturnData; override;
|
||||||
|
|
||||||
@ -56,7 +56,7 @@ interface
|
|||||||
|
|
||||||
function TargetValid: boolean; override;
|
function TargetValid: boolean; override;
|
||||||
procedure ActivateClient; override;
|
procedure ActivateClient; override;
|
||||||
procedure GetMousePosition(var x,y: integer); override;
|
procedure GetMousePosition(out x,y: integer); override;
|
||||||
procedure MoveMouse(x,y: integer); override;
|
procedure MoveMouse(x,y: integer); override;
|
||||||
procedure HoldMouse(x,y: integer; button: TClickType); override;
|
procedure HoldMouse(x,y: integer; button: TClickType); override;
|
||||||
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
|
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
|
||||||
@ -256,11 +256,9 @@ implementation
|
|||||||
result := self.window;
|
result := self.window;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TWindow.GetTargetDimensions(var w, h: integer);
|
procedure TWindow.GetTargetDimensions(out w, h: integer);
|
||||||
var
|
var
|
||||||
Attrib: TXWindowAttributes;
|
Attrib: TXWindowAttributes;
|
||||||
newx, newy: integer;
|
|
||||||
childwindow: x.TWindow;
|
|
||||||
begin
|
begin
|
||||||
if XGetWindowAttributes(display, window, @Attrib) <> 0 Then
|
if XGetWindowAttributes(display, window, @Attrib) <> 0 Then
|
||||||
begin
|
begin
|
||||||
@ -273,11 +271,9 @@ implementation
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TWindow.GetTargetPosition(var left, top: integer);
|
procedure TWindow.GetTargetPosition(out left, top: integer);
|
||||||
var
|
var
|
||||||
Attrib: TXWindowAttributes;
|
Attrib: TXWindowAttributes;
|
||||||
newx, newy: integer;
|
|
||||||
childwindow: x.TWindow;
|
|
||||||
begin
|
begin
|
||||||
if XGetWindowAttributes(display, window, @Attrib) <> 0 Then
|
if XGetWindowAttributes(display, window, @Attrib) <> 0 Then
|
||||||
begin
|
begin
|
||||||
@ -350,7 +346,7 @@ implementation
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TWindow.GetMousePosition(var x,y: integer);
|
procedure TWindow.GetMousePosition(out x,y: integer);
|
||||||
var
|
var
|
||||||
b:integer;
|
b:integer;
|
||||||
root, child: twindow;
|
root, child: twindow;
|
||||||
@ -510,7 +506,7 @@ implementation
|
|||||||
|
|
||||||
function TIOManager.SetTarget(target: x.TWindow): integer;
|
function TIOManager.SetTarget(target: x.TWindow): integer;
|
||||||
begin
|
begin
|
||||||
SetBothTargets(TWindow.Create(display, screennum, target))
|
result := SetBothTargets(TWindow.Create(display, screennum, target))
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TIOManager.GetProcesses: TSysProcArr;
|
function TIOManager.GetProcesses: TSysProcArr;
|
||||||
|
@ -98,7 +98,7 @@ procedure OffsetATPA(var ATPA : T2DPointArray; const Offset : TPoint);
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
math,mmath;
|
math;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -205,11 +205,11 @@ begin
|
|||||||
if Lo < iHi then QuickSort(A, Lo, iHi) ;
|
if Lo < iHi then QuickSort(A, Lo, iHi) ;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
const
|
{const
|
||||||
flnC=545947;
|
flnC=545947;
|
||||||
fsqrtA:single=0.5;
|
fsqrtA:single=0.5;
|
||||||
|
|
||||||
{{$ASMMODE INTEL}
|
{$ASMMODE INTEL}
|
||||||
function fsqrt(x: Single): Single;
|
function fsqrt(x: Single): Single;
|
||||||
begin
|
begin
|
||||||
asm
|
asm
|
||||||
|
Loading…
Reference in New Issue
Block a user