1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-04 22:52:15 -05:00
Simba/Units/MMLAddon/PSInc/uPSC_mml.pas

378 lines
19 KiB
ObjectPascal

unit uPSC_mml;
interface
uses
uPSCompiler;
procedure SIRegister_MML(cl: TPSPascalCompiler);
implementation
procedure SIRegister_TMufasaBitmap(cl : TPSPascalCompiler);
begin
with cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap') do
begin;
RegisterMethod('procedure SetSize(AWidth,AHeight : integer);');
RegisterMethod('procedure StretchResize(AWidth,AHeight : integer);');
RegisterMethod('procedure FastSetPixel(x,y : integer; Color : TColor);');
RegisterMethod('procedure FastSetPixels(TPA : TPointArray; Colors : TIntegerArray);');
RegisterMethod('procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);');
RegisterMethod('procedure DrawTPA(TPA : TPointArray; Color : TColor);');
RegisterMethod('procedure DrawToCanvas(x, y: Integer; Canvas: TCanvas);');
RegisterMethod('function FastGetPixel(x,y : integer) : TColor;');
RegisterMethod('procedure CopyClientToBitmap(IOManager : TObject; Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);');
RegisterMethod('procedure Rectangle(const Box : TBox; FillCol : TColor);');
RegisterMethod('procedure FloodFill(const StartPT : TPoint; const SearchCol,ReplaceCol : TColor);');
// function FastGetPixels(TPA : TPointArray) : TIntegerArray;
RegisterMethod('procedure SetTransparentColor(Col : TColor);');
RegisterMethod('function GetTransparentColor : TColor;');
RegisterProperty('TransparentColorSet','Boolean',iptR);
RegisterMethod('procedure FastDrawClear(Color : TColor);');
RegisterMethod('procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);');
RegisterMethod('procedure FastReplaceColor(OldColor, NewColor: TColor);');
RegisterMethod('procedure RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );');
RegisterMethod('procedure Desaturate(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure GreyScale(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure Brightness(TargetBitmap : TMufasaBitmap; br : integer);');
RegisterMethod('procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);');
RegisterMethod('procedure Invert(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);');
RegisterMethod('function Copy(const xs,ys,xe,ye : integer) : TMufasaBitmap;');
RegisterMethod('function ToString : string;');
RegisterMethod('function ToTBitmap : TBitmap;');
RegisterMethod('function CreateTMask : TMask;');
RegisterMethod('constructor create');
RegisterMethod('procedure Free');
RegisterMethod('function SaveToFile(const FileName : string) :boolean;');
RegisterMethod('procedure LoadFromFile(const FileName : string);');
RegisterProperty('Width','Integer',iptR);
RegisterProperty('Height','Integer',iptR);
RegisterProperty('Index','Integer',iptR);
RegisterProperty('Name','String',iptRW);
end;
end;
procedure SIRegister_TRegExp(cl : TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('Exception'),'ERegExpr') do
begin
RegisterProperty('ErrorCode', 'integer', iptrw);
RegisterProperty('CompilerErrorPos', 'integer', iptrw);
end;
with cl.AddClassN(cl.FindClass('TObject'),'TRegExp') do
begin
RegisterMethod('Constructor Create');
RegisterMethod('Function VersionMajor : integer');
RegisterMethod('Function VersionMinor : integer');
RegisterProperty('Expression', 'String', iptrw);
RegisterProperty('ModifierStr', 'String', iptrw);
RegisterProperty('ModifierI', 'boolean', iptrw);
RegisterProperty('ModifierR', 'boolean', iptrw);
RegisterProperty('ModifierS', 'boolean', iptrw);
RegisterProperty('ModifierG', 'boolean', iptrw);
RegisterProperty('ModifierM', 'boolean', iptrw);
RegisterProperty('ModifierX', 'boolean', iptrw);
RegisterMethod('Function Exec( const AInputString : String) : boolean;');
RegisterMethod('Function ExecNext : boolean');
RegisterMethod('Function ExecPos( AOffset : integer) : boolean');
RegisterProperty('InputString', 'String', iptrw);
RegisterMethod('Function Substitute( const ATemplate : String) : String');
RegisterMethod('Procedure Split( AInputStr : String; APieces : TStrings)');
RegisterMethod('Function Replace( AInputStr : String; const AReplaceStr : String; AUseSubstitution : boolean) : String;');
RegisterProperty('SubExprMatchCount', 'integer', iptr);
RegisterProperty('MatchPos', 'integer integer', iptr);
RegisterProperty('MatchLen', 'integer integer', iptr);
RegisterProperty('Match', 'String integer', iptr);
RegisterMethod('Function LastError : integer');
RegisterMethod('Function ErrorMsg( AErrorID : integer) : String');
RegisterProperty('CompilerErrorPos', 'integer', iptr);
RegisterProperty('SpaceChars', 'String', iptrw);
RegisterProperty('WordChars', 'String', iptrw);
RegisterProperty('LineSeparators', 'String', iptrw);
RegisterProperty('LinePairedSeparator', 'String', iptrw);
RegisterMethod('Function InvertCaseFunction( const Ch : Char) : Char');
RegisterProperty('InvertCase', 'TRegExprInvertCaseFunction', iptrw);
RegisterMethod('Procedure Compile');
RegisterMethod('Function Dump : String');
end;
end;
procedure SIRegister_TMDTM(cl : TPSPascalCompiler);
begin
with cl.AddClassN(cl.FindClass('TObject'),'TMDTM') do
begin
RegisterMethod('constructor create;');
RegisterMethod('procedure free;');
RegisterProperty('Name','String',iptrw);
RegisterMethod('function ToString : string');
RegisterMethod('function LoadFromString(const s : string) : boolean;');
RegisterMethod('procedure Normalize;');
RegisterMethod('function Valid:boolean');
RegisterMethod('procedure DeletePoint( Point : integer);');
RegisterMethod('procedure SwapPoint(p1,p2 : integer);');
RegisterMethod('procedure MovePoint(fromIndex,toIndex : integer);');
RegisterMethod('procedure AddPoint( Point : TMDTMPoint);');
RegisterProperty('Count','Integer',iptrw);
RegisterProperty('Index','Integer',iptr);
RegisterProperty('Points','TMDTMPointArray',iptr);
end;
end;
procedure SIRegister_TMMLSettingsSandbox(CL : TPSPascalCompiler);
begin
with cl.AddClassN(nil,'TMMLSettingsSandbox') do
begin;
RegisterMethod('function IsKey(const KeyName: String): Boolean;');
RegisterMethod('function IsDirectory(const KeyName: String): Boolean;');
RegisterMethod('function SetKeyValue(const Keyname, Value : string) : boolean;');
RegisterMethod('function GetKeyValue(const KeyName: String): String;');
RegisterMethod('function GetKeyValueDef(const KeyName, defVal: String): String;');
RegisterMethod('function ListKeys(const KeyName: String; out Keys :TStringArray): boolean;');
RegisterMethod('function DeleteKey(const KeyName: String): Boolean;');
RegisterMethod('function DeleteSubKeys(const KeyName: String): Boolean;');
RegisterProperty('Prefix','String',iptR);
end;
end;
procedure SIRegister_TMDTMS(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TObject'),'TMDTMS') do
begin
RegisterMethod('Function AddSDTM( const d : TSDTM) : Integer;');
RegisterMethod('Function AddMDTM( const d : TMDTM) : Integer;');
RegisterMethod('Function GetDTM( index : Integer) : TMDTM');
RegisterMethod('Procedure FreeDTM( DTM : Integer)');
RegisterMethod('Function StringToDTM( const S : String) : Integer');
RegisterProperty('DTM', 'TMDTM integer', iptr);
SetDefaultPropery('DTM');
RegisterMethod('Constructor Create( Owner : TObject)');
end;
end;
procedure SIRegister_TMFinder(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TObject'),'TMFinder') do
begin
RegisterProperty('WarnOnly', 'boolean', iptrw);
RegisterMethod('Procedure DefaultOperations( var xs, ys, xe, ye : integer)');
RegisterMethod('Function FindColorsToleranceOptimised( out Points : TPointArray; Color, xs, ys, xe, ye, Tol : Integer) : Boolean');
RegisterMethod('Function FindColorToleranceOptimised( out x, y : Integer; Color, xs, ys, xe, ye, tol : Integer) : Boolean');
RegisterMethod('Function CountColorTolerance( Color, xs, ys, xe, ye, Tolerance : Integer) : Integer');
RegisterMethod('Function CountColor( Color, xs, ys, xe, ye : Integer) : Integer');
RegisterMethod('Function SimilarColors( Color1, Color2, Tolerance : Integer) : boolean');
RegisterMethod('Function FindColor( out x, y : Integer; Color, xs, ys, xe, ye : Integer) : Boolean');
RegisterMethod('Function FindColorSpiral( var x, y : Integer; color, xs, ys, xe, ye : Integer) : Boolean');
RegisterMethod('Function FindColorSpiralTolerance( var x, y : Integer; color, xs, ys, xe, ye, Tol : Integer) : Boolean');
RegisterMethod('Function FindColorTolerance( out x, y : Integer; Color, xs, ys, xe, ye, tol : Integer) : Boolean');
RegisterMethod('Function FindColorsTolerance( out Points : TPointArray; Color, xs, ys, xe, ye, Tol : Integer) : Boolean');
RegisterMethod('Function FindColorsSpiralTolerance( x, y : Integer; out Points : TPointArray; color, xs, ys, xe, ye : Integer; Tolerance : Integer) : boolean');
RegisterMethod('Function FindColors( var TPA : TPointArray; Color, xs, ys, xe, ye : Integer) : Boolean');
RegisterMethod('Function FindColoredArea( var x, y : Integer; color, xs, ys, xe, ye : Integer; MinArea : Integer) : Boolean');
RegisterMethod('Function FindColoredAreaTolerance( var x, y : Integer; color, xs, ys, xe, ye : Integer; MinArea, tol : Integer) : Boolean');
RegisterMethod('Function FindMaskTolerance( const mask : TMask; out x, y : Integer; xs, ys, xe, ye : Integer; Tolerance, ContourTolerance : Integer) : Boolean');
RegisterMethod('Procedure CheckMask( const Mask : TMask)');
RegisterMethod('Function FindBitmap( bitmap : TMufasaBitmap; out x, y : Integer) : Boolean');
RegisterMethod('Function FindBitmapIn( bitmap : TMufasaBitmap; out x, y : Integer; xs, ys, xe, ye : Integer) : Boolean');
RegisterMethod('Function FindBitmapToleranceIn( bitmap : TMufasaBitmap; out x, y : Integer; xs, ys, xe, ye : Integer; tolerance : Integer) : Boolean');
RegisterMethod('Function FindBitmapSpiral( bitmap : TMufasaBitmap; var x, y : Integer; xs, ys, xe, ye : Integer) : Boolean');
RegisterMethod('Function FindBitmapSpiralTolerance( bitmap : TMufasaBitmap; var x, y : Integer; xs, ys, xe, ye, tolerance : integer) : Boolean');
RegisterMethod('Function FindBitmapsSpiralTolerance( bitmap : TMufasaBitmap; x, y : Integer; out Points : TPointArray; xs, ys, xe, ye, tolerance : Integer) : Boolean');
RegisterMethod('Function FindDeformedBitmapToleranceIn( bitmap : TMufasaBitmap; out x, y : Integer; xs, ys, xe, ye : Integer; tolerance : Integer; Range : Integer; AllowPartialAccuracy : Boolean; out accuracy : Extended) : Boolean');
RegisterMethod('Function FindDTM( DTM : TMDTM; out x, y : Integer; x1, y1, x2, y2 : Integer) : Boolean');
RegisterMethod('Function FindDTMs( DTM : TMDTM; out Points : TPointArray; x1, y1, x2, y2 : integer; maxToFind : Integer) : Boolean');
RegisterMethod('Function FindDTMRotated( DTM : TMDTM; out x, y : Integer; x1, y1, x2, y2 : Integer; sAngle, eAngle, aStep : Extended; out aFound : Extended; Alternating : boolean) : Boolean');
RegisterMethod('Function FindDTMsRotated( DTM : TMDTM; out Points : TPointArray; x1, y1, x2, y2 : Integer; sAngle, eAngle, aStep : Extended; out aFound : T2DExtendedArray; Alternating : boolean; maxToFind : Integer) : Boolean');
RegisterMethod('Function GetColors( const Coords : TPointArray) : TIntegerArray');
RegisterMethod('Procedure SetToleranceSpeed( nCTS : Integer)');
RegisterMethod('Function GetToleranceSpeed : Integer');
RegisterMethod('Procedure SetToleranceSpeed2Modifiers( const nHue, nSat : Extended)');
RegisterMethod('Procedure GetToleranceSpeed2Modifiers( out hMod, sMod : Extended)');
RegisterMethod('Constructor Create( aClient : TObject)');
end;
end;
procedure SIRegister_TMBitmaps(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TObject'),'TMBitmaps') do
begin
RegisterMethod('Function GetBMP( Index : integer) : TMufasaBitmap');
RegisterProperty('Bmp', 'TMufasaBitmap integer', iptr);
SetDefaultPropery('Bmp');
RegisterMethod('Function CreateBMP( w, h : integer) : Integer');
RegisterMethod('Function AddBMP( _bmp : TMufasaBitmap) : Integer');
RegisterMethod('Function CopyBMP( Bitmap : integer) : Integer');
RegisterMethod('Function CreateMirroredBitmap( bitmap : Integer; MirrorStyle : TBmpMirrorStyle) : Integer');
RegisterMethod('Function CreateBMPFromFile( const Path : string) : integer');
RegisterMethod('Function CreateBMPFromString( width, height : integer; Data : string) : integer;');
RegisterMethod('Procedure FreeBMP( Number : integer)');
RegisterMethod('Constructor Create( Owner : TObject)');
end;
end;
procedure SIRegister_TTarget(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TObject'),'TTarget') do
begin
RegisterMethod('Procedure GetTargetDimensions( var w, h : integer)');
RegisterMethod('Function GetColor( x, y : integer) : TColor');
RegisterMethod('Function ReturnData( xs, ys, width, height : Integer) : TRetData');
RegisterMethod('Procedure FreeReturnData');
RegisterMethod('Procedure ActivateClient');
RegisterMethod('Function TargetValid : boolean');
RegisterMethod('Function GetError : String');
RegisterMethod('Function ReceivedError : Boolean');
RegisterMethod('Procedure ResetError');
RegisterMethod('Procedure GetMousePosition( var x, y : integer)');
RegisterMethod('Procedure MoveMouse( x, y : integer)');
RegisterMethod('Procedure ScrollMouse( x, y : integer; Lines : integer)');
RegisterMethod('Procedure HoldMouse( x, y : integer; button : TClickType)');
RegisterMethod('Procedure ReleaseMouse( x, y : integer; button : TClickType)');
RegisterMethod('Function IsMouseButtonHeld( button : TClickType) : boolean');
RegisterMethod('Procedure SendString( str : string)');
RegisterMethod('Procedure HoldKey( key : integer)');
RegisterMethod('Procedure ReleaseKey( key : integer)');
RegisterMethod('Function IsKeyHeld( key : integer) : boolean');
RegisterMethod('Function GetKeyCode( C : char) : integer');
end;
end;
procedure SIRegister_TRawTarget(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TTarget'),'TRawTarget') do
begin
RegisterMethod('Constructor Create( rgb : Integer; w, h : integer; CopyData : boolean)');
end;
end;
procedure SIRegister_TBitmapTarget(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TTarget'),'TBitmapTarget') do
begin
RegisterMethod('Constructor Create( bitmap : TMufasaBitmap)');
end;
end;
procedure SIRegister_TWindow_Abstract(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TTarget'),'TWindow_Abstract') do
begin
end;
end;
procedure SIRegister_TEIOS_Target(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TTarget'),'TEIOS_Target') do
begin
RegisterMethod('Constructor Create( client : TEIOS_Client; initval : pointer)');
end;
end;
procedure SIRegister_TWindow(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TWindow_Abstract'),'TWindow') do
begin
{$ifdef mswindows}
RegisterMethod('Constructor Create( target : Hwnd)');
{$endif}
RegisterMethod('Function GetNativeWindow : TNativeWindow');
end;
end;
procedure SIRegister_TIOManager_Abstract(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TObject'),'TIOManager_Abstract') do
begin
RegisterMethod('Constructor Create( plugin_dir : string)');
RegisterMethod('Function GetError : String');
RegisterMethod('Function ReceivedError : Boolean');
RegisterMethod('Procedure ResetError');
RegisterMethod('Procedure SetDesktop');
RegisterMethod('Function SetTargetArray( ArrPtr : Integer; Size : TPoint) : integer;');
RegisterMethod('Function SetTargetBitmap( bmp : TMufasaBitmap) : integer;');
RegisterMethod('Function TargetValid : Boolean');
RegisterMethod('Procedure BitmapDestroyed( Bitmap : TMufasaBitmap)');
RegisterMethod('Function GetColor( x, y : integer) : TColor');
RegisterMethod('Function ReturnData( xs, ys, width, height : Integer) : TRetData');
RegisterMethod('Procedure FreeReturnData');
RegisterMethod('Procedure GetDimensions( var W, H : Integer)');
RegisterMethod('Procedure ActivateClient');
RegisterMethod('Function IsFrozen : boolean');
RegisterMethod('Procedure SetFrozen( makefrozen : boolean)');
RegisterMethod('Procedure GetMousePos( var X, Y : Integer)');
RegisterMethod('Procedure MoveMouse( X, Y : Integer)');
RegisterMethod('Procedure ScrollMouse( x, y : integer; Lines : integer)');
RegisterMethod('Procedure HoldMouse( x, y : integer; button : TClickType)');
RegisterMethod('Procedure ReleaseMouse( x, y : integer; button : TClickType)');
RegisterMethod('Procedure ClickMouse( X, Y : Integer; button : TClickType)');
RegisterMethod('Function IsMouseButtonDown( button : TClickType) : boolean');
RegisterMethod('Procedure KeyUp( key : Word)');
RegisterMethod('Procedure KeyDown( key : Word)');
RegisterMethod('Procedure PressKey( key : Word)');
RegisterMethod('Procedure SendText( text : string)');
RegisterMethod('Function isKeyDown( key : Word) : Boolean');
RegisterMethod('Function GetKeyCode( c : char) : integer');
RegisterMethod('Function GetImageTarget : TTarget;');
RegisterMethod('Function GetKeyMouseTarget : TTarget;');
RegisterMethod('Function ExportImageTarget : TTarget_Exported;');
RegisterMethod('Function ExportKeyMouseTarget : TTarget_Exported;');
RegisterMethod('Procedure GetImageTarget( var idx : integer);');
RegisterMethod('Procedure GetKeyMouseTarget( var idx : integer);');
RegisterMethod('Procedure SetImageTarget( idx : integer)');
RegisterMethod('Procedure SetKeyMouseTarget( idx : integer)');
RegisterMethod('Procedure FreeTarget( idx : integer)');
RegisterMethod('Procedure SetState( val : Boolean)');
end;
end;
procedure SIRegister_TIOManager(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TIOManager_Abstract'),'TIOManager') do
begin
RegisterMethod('Constructor Create( plugin_dir : string)');
RegisterMethod('procedure SetDesktop;');
RegisterMethod('Function SetTarget( target : TNativeWindow) : integer;');
end;
end;
procedure SIRegister_IOManager(CL: TPSPascalCompiler);
begin
SIRegister_TTarget(CL);
SIRegister_TRawTarget(CL);
SIRegister_TBitmapTarget(CL);
SIRegister_TWindow_Abstract(CL);
SIRegister_TEIOS_Target(CL);
SIRegister_TWindow(cl);
SIRegister_TIOManager_Abstract(CL);
SIRegister_TIOManager(cl);
end;
procedure SIRegister_TClient(CL: TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('TObject'),'TClient') do
begin
RegisterProperty('IOManager', 'TIOManager', iptrw);
RegisterProperty('MFiles', 'TMFiles', iptrw);
RegisterProperty('MFinder', 'TMFinder', iptrw);
RegisterProperty('MBitmaps', 'TMBitmaps', iptrw);
RegisterProperty('MDTMs', 'TMDTMS', iptrw);
RegisterProperty('MOCR', 'TMOCR', iptrw);
RegisterProperty('WritelnProc', 'TWritelnProc', iptrw);
RegisterMethod('Procedure WriteLn( s : string)');
RegisterMethod('Constructor Create( const plugin_dir : string; const UseIOManager : TIOManager)');
end;
end;
procedure SIRegister_MML(cl: TPSPascalCompiler);
begin
SIRegister_TMufasaBitmap(cl);
SIRegister_TRegExp(cl);
SIRegister_TMDTM(cL);
SIRegister_TMMLSettingsSandbox(cl);
SIRegister_TMDTMS(cl);
SIRegister_TMFinder(cl);
SIRegister_TMBitmaps(cl);
SIRegister_IOManager(cl);
SIRegister_TClient(cl);
end;
end.