moparisthebest
/
Simba
mirror of https://github.com/moparisthebest/Simba
1
0
Fork 0
Code Issues Releases Wiki Activity

Added some functions to Bitmaps, made a start with exporting TMufasaBitmap.. 

Oh and added some TPA functions, not yet exported to PS.

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@288 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-12-18 16:16:47 +00:00
parent 78af57e181
commit 2a864cac75
7 changed files with 1706 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Units/MMLAddon/PSInc/Wrappers/bitmap.inc
View File

@ -106,6 +106,20 @@ begin;
CurrThread.Client.MBitmaps.Bmp[Bmp].FastSetPixels(TPA,Colors);
end;
procedure DrawTPABitmap(bitmap : integer; TPA : TPointArray; Color : integer);
begin
CurrThread.Client.MBitmaps.Bmp[Bitmap].DrawTPA(TPA,Color);
end;
procedure DrawATPABitmap(bitmap : integer; ATPA : T2DPointArray);
begin
CurrThread.Client.MBitmaps.Bmp[bitmap].DrawATPA(ATPA);
end;
procedure DrawATPABitmapEx(bitmap : integer; ATPA : T2DPointArray; Colors : TIntegerArray);
begin
CurrThread.Client.MBitmaps.Bmp[bitmap].DrawATPA(ATPA,Colors);
end;
procedure FastDrawClear(bmp : integer; Color : TColor);
begin;
CurrThread.Client.MBitmaps.Bmp[bmp].FastDrawClear(Color);

7
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -110,8 +110,8 @@ AddFunction(@FindColorsToleranceOptimised,'function FindColorsToleranceOptimised
AddFunction(@FindColorsTolerance,'function FindColorsTolerance(out Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
AddFunction(@FindColorSpiral,'function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;');
AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
AddFunction(@FindColoredArea, 'function FindColoredArea(var x, y : Integer; color, xs, ys, xe, ye, MinArea : Integer): Boolean');
AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
AddFunction(@FindColoredArea, 'function FindColoredArea(var x, y : Integer; color, xs, ys, xe, ye, MinArea : Integer): Boolean');
AddFunction(@FindColoredAreaTolerance, 'function FindColoredAreaTolerance(var x, y : Integer; color, xs, ys, xe, ye, MinArea, Tolerance : Integer): Boolean');
AddFunction(@ColorToHSL, 'procedure ColorToHSL(c: integer; out r,g,b: extended);');
@ -177,6 +177,9 @@ AddFunction(@CreateBitmapMask,'function CreateBitmapMask(Bitmap : integer) : TMa
AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; out x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; out x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapToleranceIn(bitmap: integer; out x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean;');
AddFunction(@DrawTPABitmap,'procedure DrawTPABitmap(bitmap : integer; TPA : TPointArray; Color : integer);');
AddFunction(@DrawATPABitmap,'procedure DrawATPABitmap(bitmap : integer; ATPA : T2DPointArray);');
AddFunction(@DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap : integer; ATPA : T2DPointArray; Colors : TIntegerArray);');
{tpa}
AddFunction(@SplitTPAEx,'function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;');

20
Units/MMLAddon/mmlpsthread.pas
View File

@ -303,6 +303,24 @@ begin
Result := True;
end;
procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
begin;
with cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap') do
begin;
RegisterMethod('function SaveToFile(const FileName : string) :boolean;');
RegisterMethod('procedure LoadFromFile(const FileName : string);');
end;
end;
procedure RIRegister_Mufasa(cl: TPSRuntimeClassImporter);
begin;
with cl.Add(TMufasaBitmap) do
begin
RegisterMethod(@TMufasaBitmap.SaveToFile, 'SAVETOFILE');
RegisterConstructor(@TMufasaBitmap.LoadFromFile, 'LOADFROMFILE');
end;
end;
procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler);
begin
SIRegister_Std(x);
@ -312,6 +330,7 @@ begin
SIRegister_stdctrls(x);
SIRegister_Forms(x);
SIRegister_ExtCtrls(x);
SIRegister_Mufasa(x);
end;
procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec;
@ -324,6 +343,7 @@ begin
RIRegister_stdctrls(x);
RIRegister_Forms(x);
RIRegister_ExtCtrls(x);
RIRegister_Mufasa(x);
end;
procedure TMMLPSThread.OutputMessages;

1569
Units/MMLAddon/tpa.pas
View File

File diff suppressed because it is too large Load Diff

46
Units/MMLCore/bitmaps.pas
View File

@ -51,6 +51,9 @@ type
procedure LoadFromFile(const FileName : string);
procedure FastSetPixel(x,y : integer; Color : TColor);
procedure FastSetPixels(TPA : TPointArray; Colors : TIntegerArray);
procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);overload;
procedure DrawATPA(ATPA : T2DPointArray);overload;
procedure DrawTPA(TPA : TPointArray; Color : TColor);
function FastGetPixel(x,y : integer) : TColor;
function FastGetPixels(TPA : TPointArray) : TIntegerArray;
Procedure SetTransparentColor(Col : TColor);
@ -104,7 +107,7 @@ implementation
uses
Windowutil,paszlib,DCPbase64,math,
colour_conv,window;
colour_conv,window,mufasatypesutil;
function Min(a,b:integer) : integer;
begin
@ -391,6 +394,47 @@ begin
end;
end;
procedure TMufasaBitmap.DrawATPA(ATPA: T2DPointArray; Colors: TIntegerArray);
var
lenTPA,lenATPA : integer;
i,ii : integer;
Color : TRGB32;
begin
lenATPA := High(ATPA);
if LenATPA <> High(colors) then
Raise Exception.CreateFMT('TPA/Colors Length differ -> %d : %d',[LenATPA + 1,High(Colors) + 1]);
for i := 0 to lenATPA do
begin;
lenTPA := High(ATPA[i]);
Color := RGBToBGR(Colors[i]);
for ii := 0 to lenTPA do
begin;
ValidatePoint(ATPA[i][ii].x,ATPA[i][ii].y);
FData[ATPA[i][ii].y * w + ATPA[i][ii].x] := Color;
end;
end;
end;
procedure TMufasaBitmap.DrawATPA(ATPA: T2DPointArray);
var
Colors : TIntegerArray;
i,len : integer;
begin
len := high(ATPA);
SetLength(colors,len+1);
for i := 0 to len do
Colors[i] := Random(clwhite);
DrawATPA(ATPA,Colors);
end;
procedure TMufasaBitmap.DrawTPA(TPA: TPointArray; Color: TColor);
begin
DrawATPA(ConvArr([TPA]),ConvArr([Color]));
end;
function TMufasaBitmap.FastGetPixel(x, y: integer): TColor;
begin
ValidatePoint(x,y);

2
Units/MMLCore/mufasatypes.pas
View File

@ -301,6 +301,7 @@ var
(str :'UNDEFINED'; key : $FF)
);
implementation
operator+(PT1, PT2: TPoint): TPoint;
begin
@ -312,5 +313,6 @@ begin
Result.x := PT1.x - PT2.x;
Result.y := Pt1.y - PT2.y;
end;
end.

51
Units/MMLCore/mufasatypesutil.pas Normal file
View File

@ -0,0 +1,51 @@
unit mufasatypesutil;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,mufasatypes;
function ConvArr(Arr: array of TPoint): TPointArray; overload;
function ConvArr(Arr: array of TPointArray): T2DPointArray; overload;
function ConvArr(Arr: array of Integer): TIntegerArray; overload;
implementation
function ConvArr(Arr: array of TPoint): TPointArray; overload;
var
Len : Integer;
begin;
Len := Length(Arr);
SetLength(Result, Len);
Move(Arr[Low(Arr)], Result[0], Len*SizeOf(TPoint));
end;
function ConvArr(Arr: array of TPointArray): T2DPointArray; overload;
var
Len,Len2 : Integer;
i : integer;
begin;
Len := Length(Arr);
SetLength(Result, Len);
for i := Len - 1 downto 0 do
begin
Len2 := Length(Arr[i]);
SetLength(result[i],len2);
Move(Arr[i][0],Result[i][0],Len2*SizeOf(TPoint));
end;
end;
function ConvArr(Arr: array of Integer): TIntegerArray; overload;
var
Len : Integer;
begin;
Len := Length(Arr);
SetLength(Result, Len);
Move(Arr[Low(Arr)], Result[0], Len*SizeOf(Integer));
end;
end.