moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-08-13 16:53:59 -04:00
Code Issues Releases Wiki Activity

Added tpa.pas, (just holds 1 function.. Not sure what to do)

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@275 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-12-10 22:21:21 +00:00
parent c1d6c3101d
commit 7179add741
3 changed files with 83 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -176,3 +176,6 @@ 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;');
{tpa}
AddFunction(@SplitTPAEx,'function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;');

1
Units/MMLAddon/mmlpsthread.pas
View File

@ -110,6 +110,7 @@ uses
strutils,
colour_conv,
input,
tpa, //Tpa stuff
forms,//Forms
lclintf; // for GetTickCount and others.

79
Units/MMLAddon/tpa.pas Normal file
View File

@ -0,0 +1,79 @@
{
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.
TPA functions for the Mufasa Macro Library
}
unit tpa;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, mufasatypes;
function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;
implementation
function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;
var
t1, t2, c, ec, tc, l: Integer;
tpa: TPointArray;
begin
tpa := Copy(arr);
l := High(tpa);
if (l < 0) then Exit;
SetLength(Result, l + 1);
c := 0;
ec := 0;
while ((l - ec) >= 0) do
begin
SetLength(Result[c], 1);
Result[c][0] := tpa[0];
tpa[0] := tpa[l - ec];
Inc(ec);
tc := 1;
t1 := 0;
while (t1 < tc) do
begin
t2 := 0;
while (t2 <= (l - ec)) do
begin
if (Abs(Result[c][t1].x - tpa[t2].x) <= w) and (Abs(Result[c][t1].y - tpa[t2].y) <= h) then
begin
SetLength(Result[c], tc +1);
Result[c][tc] := tpa[t2];
tpa[t2] := tpa[l - ec];
Inc(ec);
Inc(tc);
Dec(t2);
end;
Inc(t2);
end;
Inc(t1);
end;
Inc(c);
end;
SetLength(Result, c);
end;
end.