mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-25 08:48:51 -05:00
1104 lines
37 KiB
ObjectPascal
1104 lines
37 KiB
ObjectPascal
{
|
|
This file is part of the Mufasa Macro Library (MML)
|
|
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
|
|
|
MML is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation, either version 3 of the License, or
|
|
(at your option) any later version.
|
|
|
|
MML 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 General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
See the file COPYING, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
Input/Output manager for Mufasa Macro Library
|
|
}
|
|
|
|
{$mode objfpc}{$H+}
|
|
unit IOManager;
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, mufasatypes, graphics, LCLType, bitmaps, LCLIntf, libloader, dynlibs;
|
|
|
|
type
|
|
|
|
{ This is the base class for the target functionality. If it provides a target, it extends this.
|
|
| Some methods in heregratuitous provide default functionality as a convinence. Only override as nessessary }
|
|
|
|
{ TTarget }
|
|
|
|
TTarget = class(TObject)
|
|
public
|
|
|
|
{ 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.
|
|
| FreeReturnData provides default of doing nothing. }
|
|
procedure GetTargetDimensions(var w, h: integer); virtual;
|
|
function GetColor(x,y : integer) : TColor; virtual;
|
|
function ReturnData(xs, ys, width, height: Integer): TRetData; virtual;
|
|
procedure FreeReturnData; virtual;
|
|
procedure ActivateClient; virtual;
|
|
function TargetValid: boolean; virtual;
|
|
|
|
{ Sucky implementation }
|
|
function GetError: String; virtual; abstract;
|
|
function ReceivedError: Boolean; virtual; abstract;
|
|
procedure ResetError; virtual; abstract;
|
|
|
|
{ ONLY override the following methods if the target provides mouse functions, defaults to
|
|
| raise exceptions }
|
|
procedure GetMousePosition(var x,y: integer); virtual;
|
|
procedure MoveMouse(x,y: integer); virtual;
|
|
procedure ScrollMouse(x,y : integer; Lines : integer); virtual;
|
|
procedure HoldMouse(x,y: integer; button: TClickType); virtual;
|
|
procedure ReleaseMouse(x,y: integer; button: TClickType); virtual;
|
|
function IsMouseButtonHeld( button : TClickType) : boolean ; virtual;
|
|
|
|
{ ONLY override the following methods if the target provides key functions, defaults to
|
|
| raise exceptions }
|
|
procedure SendString(str: string); virtual;
|
|
procedure HoldKey(key: integer); virtual;
|
|
procedure ReleaseKey(key: integer); virtual;
|
|
function IsKeyHeld(key: integer): boolean; virtual;
|
|
function GetKeyCode(C : char) : integer; virtual;
|
|
end;
|
|
|
|
{ Implements a target that is a raw pixel array, e.g. stuff from a bitmap or a frozen state.
|
|
| Currently this uses the pointer as-is, but it might be needed to make a local copy... }
|
|
TRawTarget = class(TTarget)
|
|
public
|
|
constructor Create(rgb: prgb32; w,h: integer; CopyData : boolean = false);
|
|
destructor Destroy; override;
|
|
|
|
procedure GetTargetDimensions(var w, h: integer); override;
|
|
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
|
|
|
protected
|
|
rgb: prgb32;
|
|
freedata : boolean;
|
|
w,h: integer;
|
|
end;
|
|
|
|
TBitmapTarget = class(TTarget)
|
|
public
|
|
constructor Create(bitmap: TMufasaBitmap);
|
|
destructor Destroy; override;
|
|
|
|
procedure GetTargetDimensions(var w, h: integer); override;
|
|
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
|
|
|
protected
|
|
bitmap: TMufasaBitmap;
|
|
end;
|
|
|
|
{ Implements a target that is a Window in the operating system. This class is abstract, i.e.,
|
|
| the actual os-specific Implementation of TWindow is in one of the os units. }
|
|
|
|
{ TWindow_Abstract }
|
|
|
|
TWindow_Abstract = class(TTarget)
|
|
public
|
|
procedure GetTargetDimensions(var w, h: integer); override; abstract;
|
|
function ReturnData(xs, ys, width, height: Integer): TRetData; override; abstract;
|
|
|
|
function TargetValid: boolean; override; abstract;
|
|
|
|
procedure ActivateClient; override; abstract;
|
|
procedure GetMousePosition(var x,y: integer); override; abstract;
|
|
procedure MoveMouse(x,y: integer); override; abstract;
|
|
procedure ScrollMouse(x,y : integer; Lines : integer); override; abstract;
|
|
procedure HoldMouse(x,y: integer; button: TClickType); override; abstract;
|
|
procedure ReleaseMouse(x,y: integer; button: TClickType); override; abstract;
|
|
function IsMouseButtonHeld( button : TClickType) : boolean;override; abstract;
|
|
|
|
procedure SendString(str: string); override; abstract;
|
|
procedure HoldKey(key: integer); override; abstract;
|
|
procedure ReleaseKey(key: integer); override; abstract;
|
|
function IsKeyHeld(key: integer): boolean; override; abstract;
|
|
function GetKeyCode(C : char) : integer; override; abstract;
|
|
end;
|
|
|
|
{ Contains the pointers to a non-internal target implementation using the EIOS specification.
|
|
| N.B. this *is* the specification that I will finalize the speficication as... Once this is
|
|
| finalized that is. Trust me, its >9000 times easier to use a buffer across the language
|
|
| barrier. And the internal target implementation of EIOS will make that verry efficient. }
|
|
TEIOS_Client = record
|
|
RequestTarget: function(initdata: pointer): pointer; stdcall;
|
|
ReleaseTarget: procedure(target: pointer); stdcall;
|
|
|
|
GetTargetDimensions: procedure(target: pointer; var w, h: integer); stdcall;
|
|
GetImageBuffer: function(target: pointer): prgb32; stdcall;
|
|
UpdateImageBuffer: procedure(target: pointer); stdcall;
|
|
UpdateImageBufferBounds: procedure(target: pointer; sx,sy,ex,ey: integer); stdcall;
|
|
|
|
GetMousePosition: procedure(target: pointer; var x,y: integer); stdcall;
|
|
MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
|
|
ScrollMouse: procedure(target : pointer; x,y : integer; lines : integer); stdcall;
|
|
HoldMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
|
ReleaseMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
|
IsMouseButtonHeld : function (target : pointer; left : Boolean) : boolean; stdcall;
|
|
|
|
SendString: procedure(target: pointer; str: PChar); stdcall;
|
|
HoldKey: procedure(target: pointer; key: integer); stdcall;
|
|
ReleaseKey: procedure(target: pointer; key: integer); stdcall;
|
|
IsKeyHeld: function(target: pointer; key: integer): boolean; stdcall;
|
|
GetKeyCode : function(target : pointer; C : char) : integer; stdcall;
|
|
end;
|
|
|
|
{ Implements a EIOS target. This is, for all intensive purposes, a TRawTarget with added
|
|
| key and mouse methods, as well as the capability to request a buffer update. N.B. that
|
|
| some EIOS implementors can and will update the buffer on their own. In that case, the
|
|
| UpdateImageBuffer call is just a call to an empty method, OR does not exist. In the case
|
|
| of an EIOS client not needing a method defined, it will not be exported and will be set
|
|
| to NIL here. I think. Will get back to that. }
|
|
|
|
{ TEIOS_Target }
|
|
|
|
TEIOS_Target = class(TTarget)
|
|
public
|
|
constructor Create(client: TEIOS_Client; initval: pointer);
|
|
destructor Destroy; override;
|
|
|
|
procedure GetTargetDimensions(var w, h: integer); override;
|
|
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
|
|
|
procedure GetMousePosition(var x,y: integer); override;
|
|
procedure MoveMouse(x,y: integer); override;
|
|
procedure ScrollMouse(x,y : integer; Lines : integer); override;
|
|
procedure HoldMouse(x,y: integer; button: TClickType); override;
|
|
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
|
|
function IsMouseButtonHeld( button : TClickType) : boolean;override;
|
|
|
|
procedure SendString(str: string); override;
|
|
procedure HoldKey(key: integer); override;
|
|
procedure ReleaseKey(key: integer); override;
|
|
function IsKeyHeld(key: integer): boolean; override;
|
|
function GetKeyCode(C : char) : integer; override;
|
|
|
|
private
|
|
client: TEIOS_Client;
|
|
target: pointer;
|
|
buffer: prgb32;
|
|
width,height: integer;
|
|
end;
|
|
|
|
{ EIOS Clients will give an exported name, have a loaded library associated, and have
|
|
| a TEIOS_Client with the method pointers set. }
|
|
type TEIOS_LoadedPlugin = record
|
|
name: string;
|
|
client: TEIOS_Client;
|
|
end;
|
|
|
|
{ This is just a class that loads EIOS clients (like SMART) and sets them up to be used
|
|
| as targets. I hope to have a method like...
|
|
| function SetTarget(eios_name: pchar; init_args: variant): integer;
|
|
| where the init_args variant will be implied to be anything that can be cast to a pointer
|
|
| in the binary side after it gets out of PascalScript. So, the only thing to setup SMART
|
|
| would be the single call....
|
|
| SetTarget('SMART',SmartSetupRecord);
|
|
| Sexy, right? ;}
|
|
TEIOS_Controller = class(TGenericLoader)
|
|
public
|
|
constructor Create();
|
|
destructor Destroy; override;
|
|
|
|
function ClientExists(name: string): boolean;
|
|
function GetClient(name: string): TEIOS_Client;
|
|
|
|
protected
|
|
function InitPlugin(plugin: TLibHandle): boolean; override;
|
|
private
|
|
plugs: array of TEIOS_LoadedPlugin;
|
|
function FindClient(name:string): integer;
|
|
end;
|
|
|
|
{Basically like TEIOS_Client, only this is exported to some plugin, whilst TEIOS_Client is Imported
|
|
Not all functions have to be 'set', it depends on the kind of target (Image/KeyMouse) }
|
|
TTarget_Exported = record
|
|
Target : Pointer;
|
|
|
|
GetTargetDimensions: procedure(target: pointer; var w, h: integer); stdcall;
|
|
GetColor : function(target: pointer;x,y : integer) : integer; stdcall;
|
|
ReturnData : function(target: pointer;xs, ys, width, height: Integer): TRetData; stdcall;
|
|
FreeReturnData : procedure(target: pointer); stdcall;
|
|
|
|
GetMousePosition: procedure(target: pointer; var x,y: integer); stdcall;
|
|
MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
|
|
ScrollMouse: procedure(target: pointer; x,y : integer; Lines : integer); stdcall;
|
|
HoldMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
|
ReleaseMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
|
IsMouseButtonHeld : function (target : pointer; left : boolean) : boolean;stdcall;
|
|
|
|
SendString: procedure(target: pointer; str: PChar); stdcall;
|
|
HoldKey: procedure(target: pointer; key: integer); stdcall;
|
|
ReleaseKey: procedure(target: pointer; key: integer); stdcall;
|
|
IsKeyHeld: function(target: pointer; key: integer): boolean; stdcall;
|
|
GetKeyCode : function(target : pointer; C : char) : integer; stdcall;
|
|
end;
|
|
|
|
{ This class specifies the object that will go in the ThreadVar to give the script access
|
|
| to targets. This class is abstract, i.e., the actual os-specific Implementation of
|
|
| TIOManager is in one of the os units.
|
|
| I assume you Simba people know what the methods you made do, and I'm mantaining
|
|
| Name -> Function compatibility from the TWindow and TMInput classes (e.g. key, image,
|
|
| and window functions). I decided to split targeting into input/output == image/keymouse,
|
|
| since they sometimes are treated as seperate entities. }
|
|
|
|
{ TIOManager_Abstract }
|
|
|
|
TIOManager_Abstract = class(TObject)
|
|
public
|
|
constructor Create;
|
|
constructor Create(plugin_dir: string);
|
|
destructor Destroy; override;
|
|
|
|
{ Sucky implementation }
|
|
function GetError: String;
|
|
function ReceivedError: Boolean;
|
|
procedure ResetError;
|
|
|
|
procedure SetDesktop; virtual; abstract;
|
|
function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
|
|
function SetTarget(bmp : TMufasaBitmap) : integer; overload;
|
|
function SetTarget(name: string; initargs: pointer): integer; overload;
|
|
function TargetValid: Boolean;
|
|
procedure BitmapDestroyed(Bitmap : TMufasaBitmap);
|
|
|
|
function GetColor(x,y : integer) : TColor;
|
|
function ReturnData(xs, ys, width, height: Integer): TRetData;
|
|
procedure FreeReturnData;
|
|
|
|
procedure GetDimensions(var W, H: Integer);
|
|
procedure ActivateClient;
|
|
|
|
function IsFrozen: boolean;
|
|
procedure SetFrozen(makefrozen: boolean);
|
|
|
|
procedure GetMousePos(var X, Y: Integer);
|
|
procedure MoveMouse(X, Y: Integer);
|
|
procedure ScrollMouse(x,y : integer; Lines : integer);
|
|
procedure HoldMouse(x,y : integer; button: TClickType);
|
|
procedure ReleaseMouse(x,y : integer; button: TClickType);
|
|
procedure ClickMouse(X, Y: Integer; button: TClickType);
|
|
function IsMouseButtonDown( button : TClickType) : boolean;
|
|
|
|
procedure KeyUp(key: Word);
|
|
procedure KeyDown(key: Word);
|
|
procedure PressKey(key: Word);
|
|
procedure SendText(text: string);
|
|
function isKeyDown(key: Word): Boolean;
|
|
function GetKeyCode(c : char) : integer;
|
|
|
|
function GetImageTarget: TTarget; overload;
|
|
function GetKeyMouseTarget: TTarget; overload;
|
|
function ExportImageTarget : TTarget_Exported; overload;
|
|
function ExportKeyMouseTarget : TTarget_Exported; overload;
|
|
|
|
procedure GetImageTarget(var idx: integer); overload;
|
|
procedure GetKeyMouseTarget(var idx: integer); overload;
|
|
procedure SetImageTarget(idx: integer);
|
|
procedure SetKeyMouseTarget(idx: integer);
|
|
procedure FreeTarget(idx: integer);
|
|
procedure SetState(val: Boolean);
|
|
|
|
protected
|
|
function SetImageTarget(target: TTarget): integer;
|
|
function SetKeyMouseTarget(target: TTarget): integer;
|
|
function SetBothTargets(target: TTarget): integer;
|
|
procedure NativeInit; virtual; abstract;
|
|
procedure NativeFree; virtual; abstract;
|
|
|
|
private
|
|
keymouse: TTarget;
|
|
image: TTarget;
|
|
frozen: TTarget;
|
|
freezebuffer: prgb32;
|
|
bothsame: boolean;
|
|
FStopping: Boolean;
|
|
|
|
idxarr: array of TTarget;
|
|
|
|
function GetTargetIdx(target: TTarget): integer;
|
|
function GetIdxTarget(idx: integer): TTarget;
|
|
property Stopping: Boolean Read FStopping write SetState;
|
|
end;
|
|
|
|
{These wrappers are for an exported TTarget_Exported. This is done so a plugin can acces the current target and use its methodes}
|
|
procedure TTarget_Exported_GetTargetDimensions(target: pointer; var w, h: integer); stdcall;
|
|
function TTarget_Exported_GetColor (target: pointer;x,y : integer) : integer; stdcall;
|
|
function TTarget_Exported_ReturnData (target: pointer;xs, ys, width, height: Integer): TRetData; stdcall;
|
|
procedure TTarget_Exported_FreeReturnData(target: pointer); stdcall;
|
|
|
|
procedure TTarget_Exported_GetMousePosition(target: pointer; var x,y: integer); stdcall;
|
|
procedure TTarget_Exported_MoveMouse(target: pointer; x,y: integer); stdcall;
|
|
procedure TTarget_Exported_ScrollMouse(target: pointer; x,y : integer; Lines : integer); stdcall;
|
|
procedure TTarget_Exported_HoldMouse(target: pointer; x,y: integer; left: boolean); stdcall;
|
|
procedure TTarget_Exported_ReleaseMouse(target: pointer; x,y: integer; left: boolean); stdcall;
|
|
function TTarget_Exported_IsMouseButtonHeld(target: pointer; left : boolean) : boolean;stdcall;
|
|
|
|
procedure TTarget_Exported_SendString(target: pointer; str: PChar); stdcall;
|
|
procedure TTarget_Exported_HoldKey(target: pointer; key: integer); stdcall;
|
|
procedure TTarget_Exported_ReleaseKey(target: pointer; key: integer); stdcall;
|
|
function TTarget_Exported_IsKeyHeld(target: pointer; key: integer): boolean; stdcall;
|
|
function TTarget_Exported_GetKeyCode(target : pointer; C : char) : integer; stdcall;
|
|
|
|
implementation
|
|
|
|
uses FileUtil,
|
|
{$IFDEF MSWINDOWS} os_windows {$ENDIF}
|
|
{$IFDEF LINUX} os_linux {$ENDIF};
|
|
|
|
var eios_controller: TEIOS_Controller;
|
|
|
|
|
|
//***implementation*** TIOManager
|
|
|
|
constructor TIOManager_Abstract.Create(plugin_dir: string);
|
|
begin
|
|
inherited Create;
|
|
SetLength(idxarr,0);
|
|
eios_controller.AddPath(plugin_dir);
|
|
keymouse:= nil;
|
|
image:= nil;
|
|
frozen:= nil;
|
|
FStopping:=False;
|
|
NativeInit;
|
|
SetDesktop;
|
|
end;
|
|
|
|
constructor TIOManager_Abstract.Create;
|
|
begin
|
|
inherited Create;
|
|
keymouse:= nil;
|
|
image:= nil;
|
|
frozen:= nil;
|
|
NativeInit;
|
|
SetDesktop;
|
|
end;
|
|
|
|
destructor TIOManager_Abstract.Destroy;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i:= high(idxarr) downto 0 do
|
|
idxarr[i].Free;
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.FreeTarget(idx: integer);
|
|
begin
|
|
if idx > high(idxarr) then
|
|
raise Exception.Create('Invalid target index');
|
|
if idxarr[idx] = nil then
|
|
raise Exception.Create('Double free of target');
|
|
idxarr[idx].Free;
|
|
idxarr[idx]:= nil;
|
|
end;
|
|
|
|
function TIOManager_Abstract.GetTargetIdx(target: TTarget): integer;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result:= -1;
|
|
for i:= 0 to high(idxarr) do
|
|
begin
|
|
if idxarr[i] = target then
|
|
begin
|
|
result:= i;
|
|
exit;
|
|
end;
|
|
if (idxarr[i] = nil) and (result = -1) then
|
|
result:= i;
|
|
end;
|
|
if result = -1 then
|
|
begin
|
|
SetLength(idxarr,Length(idxarr) + 1);
|
|
result:= high(idxarr);
|
|
end;
|
|
idxarr[result]:= target;
|
|
end;
|
|
|
|
function TIOManager_Abstract.GetIdxTarget(idx: integer): TTarget;
|
|
begin
|
|
if idx > high(idxarr) then
|
|
raise Exception.Create('Invalid target index');
|
|
if idxarr[idx] = nil then
|
|
raise Exception.Create('No target with specified index');
|
|
result:= idxarr[idx];
|
|
end;
|
|
|
|
function TIOManager_Abstract.SetImageTarget(target: TTarget): integer;
|
|
begin
|
|
if IsFrozen then
|
|
raise Exception.Create('You cannot set a target when Frozen');
|
|
result:= GetTargetIdx(target);
|
|
image:= target;
|
|
end;
|
|
|
|
function TIOManager_Abstract.GetImageTarget: TTarget;
|
|
begin
|
|
result := image;
|
|
end;
|
|
|
|
function TIOManager_Abstract.SetKeyMouseTarget(target: TTarget): integer;
|
|
begin
|
|
result:= GetTargetIdx(target);
|
|
keymouse:= target;
|
|
end;
|
|
|
|
function TIOManager_Abstract.GetKeyMouseTarget: TTarget;
|
|
begin
|
|
result := keymouse;
|
|
end;
|
|
|
|
function TIOManager_Abstract.ExportImageTarget: TTarget_Exported;
|
|
begin
|
|
FillChar(result,sizeof(TTarget_Exported),0);
|
|
with result do
|
|
begin
|
|
Target:= image;
|
|
GetTargetDimensions:= @TTarget_Exported_GetTargetDimensions;
|
|
GetColor:= @TTarget_Exported_GetColor;
|
|
ReturnData := @TTarget_Exported_ReturnData;
|
|
FreeReturnData:= @TTarget_Exported_FreeReturnData;
|
|
end;
|
|
end;
|
|
|
|
function TIOManager_Abstract.ExportKeyMouseTarget: TTarget_Exported;
|
|
begin
|
|
FillChar(result,sizeof(TTarget_Exported),0);
|
|
with result do
|
|
begin
|
|
Target:= KeyMouse;
|
|
GetMousePosition := @TTarget_Exported_GetMousePosition;
|
|
MoveMouse := @TTarget_Exported_MoveMouse;
|
|
ScrollMouse:= @TTarget_Exported_ScrollMouse;
|
|
HoldMouse := @TTarget_Exported_HoldMouse;
|
|
ReleaseMouse := @TTarget_Exported_ReleaseMouse;
|
|
|
|
SendString := @TTarget_Exported_SendString;
|
|
HoldKey := @TTarget_Exported_HoldKey;
|
|
ReleaseKey := @TTarget_Exported_ReleaseKey;
|
|
IsKeyHeld := @TTarget_Exported_IsKeyHeld;
|
|
GetKeyCode := @TTarget_Exported_GetKeyCode;
|
|
end;
|
|
end;
|
|
|
|
function TIOManager_Abstract.SetBothTargets(target: TTarget): integer;
|
|
begin
|
|
if IsFrozen then
|
|
raise Exception.Create('You cannot set a target when Frozen');
|
|
result:= GetTargetIdx(target);
|
|
image:= target;
|
|
keymouse:= target;
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.SetFrozen(makefrozen: boolean);
|
|
var
|
|
w,h: integer;
|
|
buffer: TRetData;
|
|
begin
|
|
if (makefrozen) and (IsFrozen) then
|
|
raise Exception.Create('The window is already frozen.');
|
|
if makefrozen then //No need for the Frozen = nil check, already done above with the exception.
|
|
begin
|
|
frozen:= image;
|
|
frozen.GetTargetDimensions(w,h);
|
|
buffer:= frozen.ReturnData(0,0,w,h);
|
|
image:= TRawTarget.Create(buffer.Ptr,w,h,true);
|
|
frozen.FreeReturnData;
|
|
end else
|
|
begin
|
|
image.Free();
|
|
image:= frozen;
|
|
frozen:= nil;
|
|
end;
|
|
end;
|
|
|
|
function TIOManager_Abstract.IsFrozen: boolean;
|
|
begin
|
|
result:= frozen <> nil;
|
|
end;
|
|
|
|
function TIOManager_Abstract.GetColor(x,y : integer) : TColor;
|
|
begin
|
|
result:= image.GetColor(x,y);
|
|
end;
|
|
function TIOManager_Abstract.ReturnData(xs,ys,width,height: integer): TRetData;
|
|
begin
|
|
result:= image.ReturnData(xs,ys,width,height);
|
|
end;
|
|
procedure TIOManager_Abstract.FreeReturnData;
|
|
begin
|
|
image.freeReturnData();
|
|
end;
|
|
|
|
function TIOManager_Abstract.SetTarget(ArrPtr: PRGB32; Size: TPoint): integer;
|
|
begin
|
|
result:= SetImageTarget(TRawTarget.Create(ArrPtr,Size.X,Size.Y));
|
|
end;
|
|
|
|
//Only checks the current image target, not targets that might be in the indexes...
|
|
procedure TIOManager_Abstract.BitmapDestroyed(Bitmap : TMufasaBitmap);
|
|
begin
|
|
if image is TBitmapTarget then
|
|
if (TBitmapTarget(image).bitmap = Bitmap) and (not FStopping) then
|
|
raise Exception.Create('Target bitmap was destroyed!');
|
|
end;
|
|
|
|
function TIOManager_Abstract.SetTarget(bmp : TMufasaBitmap) : integer;
|
|
begin
|
|
result:= SetImageTarget(TBitmapTarget.Create(bmp));
|
|
bmp.OnDestroy:= @BitmapDestroyed;
|
|
end;
|
|
|
|
function TIOManager_Abstract.SetTarget(name: string; initargs: pointer): integer;
|
|
var
|
|
client: TEIOS_Client;
|
|
begin
|
|
if not eios_controller.ClientExists(name) then
|
|
raise Exception.Create('EIOS Client by specified name does not exist');
|
|
client:= eios_controller.GetClient(name);
|
|
result:= SetBothTargets(TEIOS_Target.Create(client, initargs));
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.SetImageTarget(idx: integer);
|
|
begin
|
|
image:= GetIdxTarget(idx);
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.SetKeyMouseTarget(idx: integer);
|
|
begin
|
|
keymouse:= GetIdxTarget(idx);
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.GetImageTarget(var idx: integer);
|
|
begin
|
|
if IsFrozen then
|
|
raise Exception.Create('Cannot get image target while frozen');
|
|
idx:= GetTargetIdx(image);
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.GetKeyMouseTarget(var idx: integer);
|
|
begin
|
|
idx:= GetTargetIdx(keymouse);
|
|
end;
|
|
|
|
function TIOManager_Abstract.TargetValid: Boolean;
|
|
begin
|
|
result:= false;
|
|
if (keymouse <> nil) and (image <> nil) then
|
|
result := (keymouse.TargetValid and image.TargetValid);
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.GetDimensions(var W, H: Integer); begin image.GetTargetDimensions(w,h) end;
|
|
procedure TIOManager_Abstract.ActivateClient;
|
|
begin
|
|
keymouse.ActivateClient();
|
|
{not sure if image needs activation or not, if its a native window keymouse == image so it should be good.}
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.GetMousePos(var X, Y: Integer);
|
|
begin
|
|
keymouse.GetMousePosition(x,y)
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.MoveMouse(X, Y: Integer);
|
|
begin
|
|
keymouse.MoveMouse(x,y);
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.ScrollMouse(x, y: integer; Lines: integer);
|
|
begin
|
|
keymouse.ScrollMouse(x,y,lines);
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.HoldMouse(x,y : integer; button: TClickType);
|
|
begin
|
|
keymouse.HoldMouse(x,y,button);
|
|
end;
|
|
procedure TIOManager_Abstract.ReleaseMouse(x,y : integer; button: TClickType);
|
|
begin
|
|
keymouse.ReleaseMouse(x,y,button);
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.ClickMouse(X, Y: Integer; button: TClickType);
|
|
begin
|
|
HoldMouse(x,y,button);
|
|
//BenLand100 note: probably should wait here
|
|
ReleaseMouse(x,y,button);
|
|
end;
|
|
|
|
function TIOManager_Abstract.IsMouseButtonDown(button: TClickType): boolean;
|
|
begin
|
|
result := keymouse.IsMouseButtonHeld(button);
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.KeyUp(key: Word);
|
|
begin
|
|
keymouse.ReleaseKey(key)
|
|
end;
|
|
procedure TIOManager_Abstract.KeyDown(key: Word);
|
|
begin
|
|
keymouse.HoldKey(key)
|
|
end;
|
|
procedure TIOManager_Abstract.PressKey(key: Word);
|
|
begin
|
|
keyup(key);
|
|
keydown(key);
|
|
end;
|
|
procedure TIOManager_Abstract.SendText(text: string);
|
|
begin
|
|
keymouse.SendString(text);
|
|
end;
|
|
|
|
function TIOManager_Abstract.isKeyDown(key: Word): Boolean;
|
|
begin
|
|
result:= keymouse.IsKeyHeld(key);
|
|
end;
|
|
|
|
function TIOManager_Abstract.GetKeyCode(c: char): integer;
|
|
begin
|
|
result := keymouse.GetKeyCode(c);
|
|
end;
|
|
|
|
function TIOManager_Abstract.GetError: String;
|
|
begin
|
|
if keymouse.ReceivedError then
|
|
exit(keymouse.GetError);
|
|
if image.ReceivedError then
|
|
exit(image.GetError);
|
|
raise Exception.Create('TIOManager_Abstract.GetError: NO ERROR!');
|
|
exit('');
|
|
end;
|
|
|
|
function TIOManager_Abstract.ReceivedError: Boolean;
|
|
begin
|
|
exit(keymouse.ReceivedError or image.ReceivedError);
|
|
end;
|
|
|
|
procedure TIOManager_Abstract.ResetError;
|
|
begin
|
|
keymouse.ResetError;
|
|
image.ResetError;
|
|
end;
|
|
|
|
// TRUE when STOPPING.
|
|
procedure TIOManager_Abstract.SetState(val: Boolean);
|
|
begin
|
|
FStopping := val;
|
|
end;
|
|
|
|
//***implementation*** TTarget
|
|
|
|
procedure TTarget.GetTargetDimensions(var w, h: integer); begin raise Exception.Create('GetTargetDimensions not available for this target'); end;
|
|
function TTarget.GetColor(x,y : integer) : TColor;
|
|
begin
|
|
with ReturnData(x,y,1,1) do
|
|
Result := RGBToColor(Ptr[0].r,Ptr[0].g,Ptr[0].b);
|
|
FreeReturnData;
|
|
end;
|
|
function TTarget.ReturnData(xs, ys, width, height: Integer): TRetData; begin raise Exception.Create('ReturnData not available for this target'); end;
|
|
procedure TTarget.FreeReturnData; begin {do nothing by default} end;
|
|
procedure TTarget.ActivateClient; begin raise Exception.Create('ActivateClient not available for this target'); end;
|
|
function TTarget.TargetValid: boolean; begin result:= true; end;
|
|
|
|
procedure TTarget.GetMousePosition(var x,y: integer); begin raise Exception.Create('GetMousePosition not available for this target'); end;
|
|
procedure TTarget.MoveMouse(x,y: integer); begin raise Exception.Create('MoveMouse not available for this target'); end;
|
|
procedure TTarget.ScrollMouse(x,y : integer; lines : integer); begin raise Exception.Create('ScrollMouse is not available for this target'); end;
|
|
procedure TTarget.HoldMouse(x,y: integer; button: TClickType); begin raise Exception.Create('HoldMouse not available for this target'); end;
|
|
procedure TTarget.ReleaseMouse(x,y: integer; button: TClickType); begin raise Exception.Create('ReleaseMouse not available for this target'); end;
|
|
function TTarget.IsMouseButtonHeld(button: TClickType): boolean; begin raise Exception.Create('IsMouseButtonHeld not available for this target'); end;
|
|
|
|
procedure TTarget.SendString(str: string); begin raise Exception.Create('SendString not available for this target'); end;
|
|
procedure TTarget.HoldKey(key: integer); begin raise Exception.Create('HoldKey not available for this target'); end;
|
|
procedure TTarget.ReleaseKey(key: integer); begin raise Exception.Create('ReleaseKey not available for this target'); end;
|
|
function TTarget.IsKeyHeld(key: integer): boolean; begin raise Exception.Create('IsKeyHeld not available for this target'); end;
|
|
function TTarget.GetKeyCode(C: char): integer;begin Exception.CreateFMT('GetKeyCode - char (%s) to key is not available for this target.',[c]); end;
|
|
|
|
//***implementation*** TEIOS_Target
|
|
|
|
constructor TEIOS_Target.Create(client: TEIOS_Client; initval: pointer); begin
|
|
inherited Create;
|
|
self.client:= client;
|
|
if Pointer(client.RequestTarget) <> nil then
|
|
self.target:= client.RequestTarget(initval);
|
|
if Pointer(client.GetImageBuffer) <> nil then
|
|
self.buffer:= client.GetImageBuffer(target)
|
|
else
|
|
self.buffer:= nil;
|
|
GetTargetDimensions(self.width,self.height);
|
|
end;
|
|
|
|
destructor TEIOS_Target.Destroy; begin
|
|
client.ReleaseTarget(self.target);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TEIOS_Target.GetTargetDimensions(var w, h: integer);
|
|
begin
|
|
if Pointer(client.GetTargetDimensions) <> nil then
|
|
client.GetTargetDimensions(target,w,h)
|
|
else
|
|
inherited GetTargetDimensions(w,h);
|
|
end;
|
|
function TEIOS_Target.ReturnData(xs, ys, width, height: Integer): TRetData;
|
|
begin
|
|
if Pointer(client.UpdateImageBufferBounds) <> nil then
|
|
client.UpdateImageBufferBounds(target,xs,ys,xs+width,ys+height)
|
|
else if Pointer(client.UpdateImageBuffer) <> nil then
|
|
client.UpdateImageBuffer(target)
|
|
else begin
|
|
{no update command exported}
|
|
end;
|
|
result.Ptr := buffer;
|
|
result.RowLen:= self.width;
|
|
result.IncPtrWith:= result.RowLen - width;
|
|
Inc(result.Ptr, ys * result.RowLen + xs);
|
|
end;
|
|
|
|
procedure TEIOS_Target.GetMousePosition(var x,y: integer);
|
|
begin
|
|
if Pointer(client.GetMousePosition) <> nil then
|
|
client.GetMousePosition(target,x,y)
|
|
else
|
|
inherited GetMousePosition(x,y);
|
|
end;
|
|
procedure TEIOS_Target.MoveMouse(x,y: integer);
|
|
begin
|
|
if Pointer(client.MoveMouse) <> nil then
|
|
client.MoveMouse(target,x,y)
|
|
else
|
|
inherited MoveMouse(x,y);
|
|
end;
|
|
procedure TEIOS_Target.ScrollMouse(x,y : integer; Lines : integer);
|
|
begin
|
|
if Pointer(Client.ScrollMouse) <> nil then
|
|
client.ScrollMouse(target,x,y,lines)
|
|
else
|
|
inherited Scrollmouse(x,y,lines);
|
|
end;
|
|
|
|
procedure TEIOS_Target.HoldMouse(x,y: integer; button: TClickType);
|
|
begin
|
|
if Pointer(client.HoldMouse) <> nil then
|
|
begin
|
|
case button of
|
|
mouse_Left: client.HoldMouse(target,x,y,true);
|
|
mouse_Middle: raise Exception.Create('EIOS does not implement the middle mouse button.');
|
|
mouse_Right: client.HoldMouse(target,x,y,false);
|
|
end;
|
|
end else
|
|
inherited HoldMouse(x,y,button);
|
|
end;
|
|
procedure TEIOS_Target.ReleaseMouse(x,y: integer; button: TClickType);
|
|
begin
|
|
if Pointer(client.ReleaseMouse) <> nil then
|
|
begin
|
|
case button of
|
|
mouse_Left: client.ReleaseMouse(target,x,y,true);
|
|
mouse_Middle: raise Exception.Create('EIOS does not implement the middle mouse button.');
|
|
mouse_Right: client.ReleaseMouse(target,x,y,false);
|
|
end;
|
|
end else
|
|
inherited ReleaseMouse(x,y,button);
|
|
end;
|
|
|
|
function TEIOS_Target.IsMouseButtonHeld(button: TClickType): boolean;
|
|
begin
|
|
if Pointer(client.IsMouseButtonHeld) <> nil then
|
|
begin
|
|
case button of
|
|
mouse_Left: result := client.IsMouseButtonHeld(target,true);
|
|
mouse_Middle: raise Exception.Create('EIOS does not implement the middle mouse button.');
|
|
mouse_Right: result := client.IsMouseButtonHeld(target,false);
|
|
end;
|
|
end else
|
|
result := inherited IsMouseButtonHeld(button);
|
|
end;
|
|
|
|
procedure TEIOS_Target.SendString(str: string);
|
|
begin
|
|
if Pointer(client.SendString) <> nil then
|
|
client.SendString(target,PChar(str))
|
|
else
|
|
inherited SendString(str);
|
|
end;
|
|
procedure TEIOS_Target.HoldKey(key: integer);
|
|
begin
|
|
if Pointer(client.HoldKey) <> nil then
|
|
client.HoldKey(target,key)
|
|
else
|
|
inherited HoldKey(key);
|
|
end;
|
|
procedure TEIOS_Target.ReleaseKey(key: integer);
|
|
begin
|
|
if Pointer(client.ReleaseKey) <> nil then
|
|
client.ReleaseKey(target,key)
|
|
else
|
|
inherited ReleaseKey(key);
|
|
end;
|
|
function TEIOS_Target.IsKeyHeld(key: integer): boolean;
|
|
begin
|
|
if Pointer(client.IsKeyHeld) <> nil then
|
|
result:= client.IsKeyHeld(target,key)
|
|
else
|
|
result:= inherited IsKeyHeld(key);
|
|
end;
|
|
|
|
function TEIOS_Target.GetKeyCode(C: char): integer;
|
|
begin
|
|
if Pointer(client.GetKeyCode) <> nil then
|
|
result:= client.GetKeyCode(target,C)
|
|
else
|
|
result:= inherited GetKeyCode(C);
|
|
end;
|
|
|
|
//***implementation*** TRawTarget
|
|
|
|
constructor TRawTarget.Create(rgb: prgb32; w,h: integer; CopyData : boolean = false);
|
|
begin
|
|
inherited Create;
|
|
self.w:= w;
|
|
self.h:= h;
|
|
self.freedata:= copydata;
|
|
if CopyData then
|
|
begin
|
|
GetMem(self.rgb,w*h*sizeof(TRGB32));
|
|
Move(rgb[0],self.rgb[0],w*h*sizeof(TRGB32));
|
|
end else
|
|
self.rgb:= rgb;
|
|
end;
|
|
|
|
destructor TRawTarget.Destroy;
|
|
begin
|
|
if freedata then
|
|
Freemem(self.rgb,w*h*sizeof(TRGB32));
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TRawTarget.GetTargetDimensions(var w, h: integer);
|
|
begin
|
|
w:= self.w;
|
|
h:= self.h;
|
|
end;
|
|
|
|
function TRawTarget.ReturnData(xs, ys, width, height: Integer): TRetData;
|
|
begin
|
|
result.Ptr := rgb;
|
|
result.RowLen:= self.w;
|
|
result.IncPtrWith:= result.RowLen - width;
|
|
Inc(result.Ptr, ys * result.RowLen + xs);
|
|
end;
|
|
|
|
//***implementation*** TBitmapTarget
|
|
|
|
constructor TBitmapTarget.Create(bitmap: TMufasaBitmap);
|
|
begin
|
|
inherited Create;
|
|
self.bitmap:= bitmap;
|
|
end;
|
|
|
|
destructor TBitmapTarget.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TBitmapTarget.GetTargetDimensions(var w, h: integer);
|
|
begin
|
|
h:= bitmap.Height;
|
|
w:= bitmap.Width;
|
|
end;
|
|
|
|
function TBitmapTarget.ReturnData(xs, ys, width, height: Integer): TRetData;
|
|
begin
|
|
result.Ptr := bitmap.FData;
|
|
result.RowLen:= bitmap.Width;
|
|
result.IncPtrWith:= result.RowLen - width;
|
|
Inc(result.Ptr, ys * result.RowLen + xs);
|
|
end;
|
|
|
|
//***implementation*** TEIOS_Controller
|
|
|
|
constructor TEIOS_Controller.Create();
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TEIOS_Controller.Destroy;
|
|
begin
|
|
SetLength(plugs,0);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TEIOS_Controller.InitPlugin(plugin: TLibHandle): boolean;
|
|
var
|
|
GetName: procedure(name: pchar); stdcall;
|
|
buffer: pchar;
|
|
idx: integer;
|
|
begin
|
|
Pointer(GetName) := GetProcAddress(plugin, PChar('EIOS_GetName'));
|
|
if Pointer(GetName) = nil then begin result:= false; exit; end;
|
|
idx:= Length(plugs);
|
|
SetLength(plugs,idx+1);
|
|
buffer:= stralloc(255);
|
|
GetName(buffer);
|
|
plugs[idx].name:= buffer;
|
|
strdispose(buffer);
|
|
{link in all eios methods that *might* exist}
|
|
with plugs[idx].client do
|
|
begin
|
|
Pointer(RequestTarget):= GetProcAddress(plugin, PChar('EIOS_RequestTarget'));
|
|
Pointer(ReleaseTarget):= GetProcAddress(plugin, PChar('EIOS_ReleaseTarget'));
|
|
|
|
Pointer(GetTargetDimensions):= GetProcAddress(plugin, PChar('EIOS_GetTargetDimensions'));
|
|
Pointer(GetImageBuffer):= GetProcAddress(plugin, PChar('EIOS_GetImageBuffer'));
|
|
Pointer(UpdateImageBuffer):= GetProcAddress(plugin, PChar('EIOS_UpdateImageBuffer'));
|
|
Pointer(UpdateImageBufferBounds):= GetProcAddress(plugin, PChar('EIOS_UpdateImageBufferBounds'));
|
|
|
|
Pointer(GetMousePosition):= GetProcAddress(plugin, PChar('EIOS_GetMousePosition'));
|
|
Pointer(MoveMouse):= GetProcAddress(plugin, PChar('EIOS_MoveMouse'));
|
|
Pointer(ScrollMouse) := GetProcAddress(plugin,PChar('EIOS_ScrollMouse'));
|
|
Pointer(HoldMouse):= GetProcAddress(plugin, PChar('EIOS_HoldMouse'));
|
|
Pointer(ReleaseMouse):= GetProcAddress(plugin, PChar('EIOS_ReleaseMouse'));
|
|
|
|
Pointer(SendString):= GetProcAddress(plugin, PChar('EIOS_SendString'));
|
|
Pointer(HoldKey):= GetProcAddress(plugin, PChar('EIOS_HoldKey'));
|
|
Pointer(ReleaseKey):= GetProcAddress(plugin, PChar('EIOS_ReleaseKey'));
|
|
Pointer(IsKeyHeld):= GetProcAddress(plugin, PChar('EIOS_IsKeyHeld'));
|
|
end;
|
|
{done linking in methods}
|
|
result:= true;
|
|
end;
|
|
|
|
function TEIOS_Controller.FindClient(name: string): integer;
|
|
var
|
|
i: integer;
|
|
begin
|
|
i:= LoadPlugin(name);
|
|
result:= -1;
|
|
end;
|
|
|
|
function TEIOS_Controller.ClientExists(name: string): boolean;
|
|
begin
|
|
result:= FindClient(name) >= 0;
|
|
end;
|
|
|
|
function TEIOS_Controller.GetClient(name: string): TEIOS_Client;
|
|
var
|
|
i: integer;
|
|
begin
|
|
i:= FindClient(name);
|
|
if i >= 0 then
|
|
result:= plugs[i].client
|
|
end;
|
|
|
|
//***implementation*** TEIS_Exported wrappers
|
|
|
|
procedure TTarget_Exported_GetTargetDimensions(target: pointer; var w,
|
|
h: integer); stdcall;
|
|
begin
|
|
TTarget(Target).GetTargetDimensions(w,h);
|
|
end;
|
|
|
|
function TTarget_Exported_GetColor(target: pointer;x, y: integer): integer; stdcall;
|
|
begin
|
|
result := TTarget(Target).GetColor(x,y);
|
|
end;
|
|
|
|
function TTarget_Exported_ReturnData(target: pointer;xs, ys, width, height: Integer): TRetData;
|
|
stdcall;
|
|
begin
|
|
result := TTarget(Target).ReturnData(xs,ys,width,height);
|
|
end;
|
|
|
|
procedure TTarget_Exported_FreeReturnData(target: pointer); stdcall;
|
|
begin
|
|
TTarget(target).FreeReturnData;
|
|
end;
|
|
|
|
|
|
procedure TTarget_Exported_GetMousePosition(target: pointer; var x, y: integer
|
|
); stdcall;
|
|
begin
|
|
TTarget(Target).GetMousePosition(x,y);
|
|
end;
|
|
|
|
procedure TTarget_Exported_MoveMouse(target: pointer; x, y: integer); stdcall;
|
|
begin
|
|
TTarget(Target).MoveMouse(x,y);
|
|
end;
|
|
procedure TTarget_Exported_ScrollMouse(target: pointer; x, y: integer;
|
|
Lines: integer); stdcall;
|
|
begin
|
|
TTarget(Target).ScrollMouse(x,y,lines);
|
|
end;
|
|
|
|
procedure TTarget_Exported_HoldMouse(target: pointer; x, y: integer;
|
|
left: boolean); stdcall;
|
|
begin
|
|
if left then
|
|
TTarget(Target).HoldMouse(x,y,mouse_left)
|
|
else
|
|
TTarget(Target).HoldMouse(x,y,mouse_right);
|
|
end;
|
|
|
|
procedure TTarget_Exported_ReleaseMouse(target: pointer; x, y: integer;
|
|
left: boolean); stdcall;
|
|
begin
|
|
if left then
|
|
TTarget(Target).ReleaseMouse(x,y,mouse_left)
|
|
else
|
|
TTarget(Target).ReleaseMouse(x,y,mouse_right);
|
|
end;
|
|
|
|
function TTarget_Exported_IsMouseButtonHeld(target: pointer; left: boolean
|
|
): boolean; stdcall;
|
|
begin
|
|
if left then
|
|
result := TTarget(Target).IsMouseButtonHeld(mouse_left)
|
|
else
|
|
result := TTarget(Target).IsMouseButtonHeld(mouse_right);
|
|
end;
|
|
|
|
procedure TTarget_Exported_SendString(target: pointer; str: PChar); stdcall;
|
|
begin
|
|
TTarget(Target).SendString(str);
|
|
end;
|
|
|
|
procedure TTarget_Exported_HoldKey(target: pointer; key: integer); stdcall;
|
|
begin
|
|
TTarget(Target).HoldKey(key);
|
|
end;
|
|
|
|
procedure TTarget_Exported_ReleaseKey(target: pointer; key: integer); stdcall;
|
|
begin
|
|
TTarget(Target).ReleaseKey(key);
|
|
end;
|
|
|
|
function TTarget_Exported_IsKeyHeld(target: pointer; key: integer): boolean;
|
|
stdcall;
|
|
begin
|
|
result := TTarget(Target).IsKeyHeld(key);
|
|
end;
|
|
|
|
function TTarget_Exported_GetKeyCode(target: pointer; C: char): integer;
|
|
stdcall;
|
|
begin
|
|
result := TTarget(target).GetKeyCode(c);
|
|
end;
|
|
|
|
initialization
|
|
eios_controller:= TEIOS_Controller.Create;
|
|
finalization
|
|
eios_controller.Free;
|
|
end.
|