From: Iroki
So, because noone pmd me details of acc in pp random i decided to post it without "in random tests" It is only tested on the bmps which i have.
Code was made in delphi, lazarus wasn't working for me :/ and it is compatible with scar. Anyone who want to work on this code, feel free to do it. :D
With love for You, Iroki :)
library PrisonPete_scar;
uses
SysUtils,
Classes,
Windows,
Math,
Graphics;
{$R *.res}
type
TSCARPlugFunc = record
Name: ansistring;
Ptr: Pointer;
end;
TOneStrProc = procedure(s: ansistring);
TSCARWindowHandle = function(): Integer;
type
TRGB32 = packed record
B, G, R, A: Byte;
end;
TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32) - 1] of TRGB32;
PRGB32Array = ^TRGB32Array;
TPointArray = array of TPoint;
var
Writeln: TOneStrProc;
GetClientWindowHandle: TSCARWindowHandle;
FillInfo: Boolean;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prison Pete
By: Iroki
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
type
AnimalCorner = record
x1, y1, x2, y2: integer;
end;
function Pete_FindAnimal2(var px, py: Integer; AnimalId: Integer; ClientHDC: HDC): Boolean; stdcall;
var
BMP: TBitmap;
Line: PRGB32Array;
x, y, w, h: Integer;
c: array of array of Integer;
Found1: Boolean;
AnimalCorners: AnimalCorner;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There is no need to describe this procedure.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure ColorAreaInsideBox(x1, y1, x2, y2: integer; Color1, Color2: TColor);
var
i, j: integer;
begin
for j := y1 to y2 do
for i := x1 to x2 do
if(c[i][j] = Color1) then c[i][j] := Color2;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This function, like the name says, counts amount of pixels which are
used to create animal.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function CountAreaInsideBox(x1, y1, x2, y2: integer; Color: TColor): integer;
var
i, j, Area: integer;
begin
Area := 0;
for j := y1 to y2 do
for i := x1 to x2 do
if(c[i][j] = Color) then Area := Area + 1;
Result := Area;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This function, like the name says, counts colored area inside "animal".
Thanks to Nava2 for the little help :P
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function CountColoredAreaInsideAnimal(x1, y1, x2, y2: integer; Color: TColor): integer;
const
ax : array[0..7] of ShortInt = (1, 0,-1, 0, 1, 1,-1,-1);
ay : array[0..7] of ShortInt = (0, 1, 0,-1,-1, 1, 1,-1);
var
i, j, k, area: integer;
tmp_bool: boolean;
begin
Area := 0;
for j := y1 to y2 do
for i := x1 to x2 do
if(c[i][j] = Color) then
begin
tmp_bool := True;
for k := 0 to 7 do
if (c[i + ax[k]][j + ay[k]] <> Color) then
begin
tmp_bool := False;
break;
end;
if tmp_bool then area := area + 1;
end;
Result := area;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This function counts pixels used to create outline of animal.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function CountOutlineInBox(x1, y1, x2, y2: integer; Color: TColor): integer;
begin
Result := (CountAreaInsideBox(x1, y1, x2, y2, Color) -
CountColoredAreaInsideAnimal(x1, y1, x2, y2, Color));
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
That lines of code was orginally created by Sky Scripter and were named "ScanFill".
I have rewrited it completely, and now it SHOULD work properly. This procedure should
theoreticaly find coordinates of "box" in which the baloon animal is.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure FloodFillAndFindAnimalBoxCoords(x, y: integer; Color1, Color2: TColor);
const
xx : array[0..3] of ShortInt = (1, -1, 0, 0);
yy : array[0..3] of ShortInt = (0, 0, 1, -1);
var
i: integer;
begin
if ((c[x][y] = Color1) and (x > 4) and (x < w - 4) and (y > 4) and (y < h - 4)) then
begin
c[x][y] := Color2;
if (AnimalCorners.x1 > x) then AnimalCorners.x1 := x;
if (AnimalCorners.x2 < x) then AnimalCorners.x2 := x;
if (AnimalCorners.y1 > y) then AnimalCorners.y1 := y;
if (AnimalCorners.y2 < y) then AnimalCorners.y2 := y;
for i := 0 to 3 do
FloodFillAndFindAnimalBoxCoords(x + xx[i], y + yy[i], Color1, Color2);
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There is no need to describe this function.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function FindGoat(Color: TColor): boolean;
var
Outline, Area: integer;
begin
Result := False;
Area := CountAreaInsideBox(AnimalCorners.x1, AnimalCorners.y1, AnimalCorners.x2, AnimalCorners.y2, Color);
Outline := CountOutlineInBox(AnimalCorners.x1, AnimalCorners.y1, AnimalCorners.x2, AnimalCorners.y2, Color);
if (InRange(Area,220, 320) and InRange(Outline, 105, 200)) then
begin
px := AnimalCorners.x1 + Round((AnimalCorners.x2 - AnimalCorners.x1)/2);
py := AnimalCorners.y1 + Round((AnimalCorners.y2 - AnimalCorners.y1)/2);
Result := True;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Same as above.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function FindCat(x1, y1, x2, y2: integer; Color: TColor): Boolean;
var
x, y, how, value, lastrowvalue, tvalue, countvalue, ones, twoes: integer;
IsLongTail: boolean;
begin
if ((x2 - x1) > (y2 - y1 + 13)) then how := 1
else if ((x2 - x1) < (y2 - y1 + 13)) then how := 2
else how := 3;
IsLongTail := False;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
Result := False;
if (how = 1)then
begin
for x := x1 to x2 do
begin
value := 0;
for y := y1 to y2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 11) then IsLongTail := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 3) and (ones > 0) and (twoes = 2)) or ((ones = 3) and (twoes = 2)) or ((ones = 3) and (twoes = 3)) or ((ones = 2) and (twoes = 3)) or ((ones = 1) and (twoes = 4))) and (IsLongTail) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
if (how = 2) then
begin
for y := y1 to y1 do
begin
value := 0;
for x := x1 to x2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 11) then IsLongTail := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 3) and (ones > 0) and (twoes = 2)) or ((ones = 3) and (twoes = 2)) or ((ones = 3) and (twoes = 3)) or ((ones = 2) and (twoes = 3)) or ((ones = 1) and (twoes = 4))) and (IsLongTail) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:P
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function FindDog(x1, y1, x2, y2: integer; Color: TColor): boolean;
var
x, y,how, value,lastrowvalue, tvalue, countvalue, ones, twoes: integer;
IsDog1, IsDog2: boolean;
begin
if ((x2 - x1) > (y2 - y1 + 13)) then how := 1
else if ((x2 - x1) < (y2 - y1 + 13)) then how := 2
else how := 3;
IsDog1 := False;
IsDog2 := False;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
Result := False;
if (how = 1)then
begin
for x := x1 to x2 do
begin
value := 0;
for y := y1 to y2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 10) then IsDog1 := True;
if (lastrowvalue = 2) and (countvalue > 8) then IsDog2 := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones = 4) and (twoes = 3)) or ((ones = 3) and (twoes = 3)) or ((ones = 3) and (twoes = 2)) or ((ones = 2) and (twoes = 3))) and (not(IsDog1)) and (not(Isdog2)) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
if (how = 2) then
begin
for y := y1 to y1 do
begin
value := 0;
for x := x1 to x2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 10) then IsDog1 := True;
if (lastrowvalue = 2) and (countvalue > 8) then IsDog2 := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones = 4) and (twoes = 3)) or ((ones = 3) and (twoes = 3)) or ((ones = 3) and (twoes = 2)) or ((ones = 2) and (twoes = 3))) and (not(IsDog1)) and (not(Isdog2)) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
^^
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function FindSheep(var x1, y1, x2, y2: integer; Color: TColor): boolean;
var
x, y, how, value, lastrowvalue, tvalue, countvalue,
ones, twoes: integer;
IsBigBody: boolean;
begin
if ((x2 - x1) > (y2 - y1 + 13)) then how := 1
else if ((x2 - x1) < (y2 - y1 + 13)) then how := 2
else how := 3;
IsBigBody := False;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
Result := False;
if (how = 1)then
begin
for x := x1 to x2 do
begin
value := 0;
for y := y1 to y2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 15) then tvalue := 2;
if (value > 15) and (value < 45) then tvalue := 3;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) or not(tvalue <> 3) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 2) and (countvalue > 11) then IsBigBody := True;
if (lastrowvalue = 2) and (countvalue > 27) then IsBigBody := False;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 4) and (ones > 0)) and ((twoes > 0) and(twoes < 3))) and (IsBigBody) and ((y2 - y1) < 27) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
if (how = 2) then
begin
for y := y1 to y2 do
begin
value := 0;
for x := x1 to x2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 15) then tvalue := 2;
if (value > 15) and (value < 45) then tvalue := 3;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) or not(tvalue <> 3) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 2) and (countvalue > 11) then IsBigBody := True;
if (lastrowvalue = 2) and (countvalue > 27) then IsBigBody := False;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 4) and (ones > 0)) and ((twoes > 0) and(twoes < 3))) and (IsBigBody) and ((x2 - x1) < 27)then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Main loop (ground detecting)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
begin
w := 516; h := 338;
Bmp := TBitmap.Create;
Bmp.Width := w;
Bmp.Height:= h;
Bmp.PixelFormat := pf32bit;
SetLength(c, w + 1, h + 1);
BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 0, 0, SRCCOPY);
Result := False;
//finding animals and coloring red
for y := 4 to h - 4 do
begin
Line := bmp.ScanLine[y];
for x := 4 to w - 4 do
begin
c[x][y] := RGB(Line[x].R, Line[x].G, Line[x].B);
if ((Line[x].G <> 0) and (Line[x].R > 150) and (Line[x].G < 120) and (Line[x].B > 120)) then
c[x][y] := clred else c[x][y] := 0;
end;
end;
Found1 := False;
for y := 4 to h - 4 do
for x := 4 to w - 4 do
if (c[x][y] = clred) then
begin
if not Found1 then
begin
AnimalCorners.x1 := w - 4;
AnimalCorners.x2 := 4;
AnimalCorners.y1 := h - 4;
AnimalCorners.y2 := 4;
FloodFillAndFindAnimalBoxCoords(x, y, clred, clyellow);
case AnimalId of
1: if FindGoat(clyellow) then Found1 := True;
2: if FindSheep(AnimalCorners.x1, AnimalCorners.y1, AnimalCorners.x2, AnimalCorners.y2, clyellow) then Found1 := True;
3: if FindCat(AnimalCorners.x1, AnimalCorners.y1, AnimalCorners.x2, AnimalCorners.y2, clyellow) then Found1 := True;
4: if FindDog(AnimalCorners.x1, AnimalCorners.y1, AnimalCorners.x2, AnimalCorners.y2, clyellow) then Found1 := True;
end;
end;
end;
Bmp.Free;
if Found1 then Result := True;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End of Prison Pete solver.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 1;
end;
function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PAnsiChar): Integer; stdcall;
begin
case x of
0:
begin
ProcAddr := @Pete_FindAnimal2;
StrPCopy(ProcDef, 'function Pete_FindAnimal2(var px, py: Integer; AnimalId: Integer; ClientHDC: HDC): Boolean;');
end;
else
x := -1;
end;
Result := x;
end;
procedure SetFunctions(Funcs: array of TSCARPlugFunc); stdcall;
var
i: Integer;
begin
for i := 0 to Length(Funcs) - 1 do
begin
if Funcs[i].Name = 'Writeln' then
Writeln := Funcs[i].Ptr;
if Funcs[i].Name = 'GetClientWindowHandle' then
GetClientWindowHandle := Funcs[i].Ptr;
end;
FillInfo := false;
end;
exports GetFunctionCount;
exports GetFunctionInfo;
exports SetFunctions;
end.
Didn't test but it compiles. Also had to add units and get rid of Windows unit.
Lazarus
library libIroki;
{$mode objfpc}{$H+}
uses
cmem, Interfaces, Classes, Sysutils, {Windows,} Math, Graphics, IntfGraphics, LCLIntf, LCLType;
type
TRGB32 = packed record
B, G, R, A: Byte;
end;
TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32) - 1] of TRGB32;
PRGB32Array = ^TRGB32Array;
TPointArray = array of TPoint;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prison Pete
By: Iroki
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
type
AnimalCorner = record
x1, y1, x2, y2: integer;
end;
function Pete_FindAnimal2(var px, py: Integer; AnimalId: Integer; ClientHDC: HDC): Boolean; stdcall;
var
BMP: TBitmap;
Line: PRGB32Array;
x, y, w, h: Integer;
c: array of array of Integer;
Found1: Boolean;
AnimalCorners: AnimalCorner;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There is no need to describe this procedure.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure ColorAreaInsideBox(x1, y1, x2, y2: integer; Color1, Color2: TColor);
var
i, j: integer;
begin
for j := y1 to y2 do
for i := x1 to x2 do
if(c[i][j] = Color1) then c[i][j] := Color2;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This function, like the name says, counts amount of pixels which are
used to create animal.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function CountAreaInsideBox(x1, y1, x2, y2: integer; Color: TColor): integer;
var
i, j, Area: integer;
begin
Area := 0;
for j := y1 to y2 do
for i := x1 to x2 do
if(c[i][j] = Color) then Area := Area + 1;
Result := Area;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This function, like the name says, counts colored area inside "animal".
Thanks to Nava2 for the little help :P
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function CountColoredAreaInsideAnimal(x1, y1, x2, y2: integer; Color: TColor): integer;
const
ax : array[0..7] of ShortInt = (1, 0,-1, 0, 1, 1,-1,-1);
ay : array[0..7] of ShortInt = (0, 1, 0,-1,-1, 1, 1,-1);
var
i, j, k, area: integer;
tmp_bool: boolean;
begin
Area := 0;
for j := y1 to y2 do
for i := x1 to x2 do
if(c[i][j] = Color) then
begin
tmp_bool := True;
for k := 0 to 7 do
if (c[i + ax[k]][j + ay[k]] <> Color) then
begin
tmp_bool := False;
break;
end;
if tmp_bool then area := area + 1;
end;
Result := area;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This function counts pixels used to create outline of animal.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function CountOutlineInBox(x1, y1, x2, y2: integer; Color: TColor): integer;
begin
Result := (CountAreaInsideBox(x1, y1, x2, y2, Color) -
CountColoredAreaInsideAnimal(x1, y1, x2, y2, Color));
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
That lines of code was orginally created by Sky Scripter and were named "ScanFill".
I have rewrited it completely, and now it SHOULD work properly. This procedure should
theoreticaly find coordinates of "box" in which the baloon animal is.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure FloodFillAndFindAnimalBoxCoords(x, y: integer; Color1, Color2: TColor);
const
xx : array[0..3] of ShortInt = (1, -1, 0, 0);
yy : array[0..3] of ShortInt = (0, 0, 1, -1);
var
i: integer;
begin
if ((c[x][y] = Color1) and (x > 4) and (x < w - 4) and (y > 4) and (y < h - 4)) then
begin
c[x][y] := Color2;
if (AnimalCorners.x1 > x) then AnimalCorners.x1 := x;
if (AnimalCorners.x2 < x) then AnimalCorners.x2 := x;
if (AnimalCorners.y1 > y) then AnimalCorners.y1 := y;
if (AnimalCorners.y2 < y) then AnimalCorners.y2 := y;
for i := 0 to 3 do
FloodFillAndFindAnimalBoxCoords(x + xx[i], y + yy[i], Color1, Color2);
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There is no need to describe this function.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function FindGoat(Color: TColor): boolean;
var
Outline, Area: integer;
begin
Result := False;
Area := CountAreaInsideBox(AnimalCorners.x1, AnimalCorners.y1, AnimalCorners.x2, AnimalCorners.y2, Color);
Outline := CountOutlineInBox(AnimalCorners.x1, AnimalCorners.y1, AnimalCorners.x2, AnimalCorners.y2, Color);
if (InRange(Area,220, 320) and InRange(Outline, 105, 200)) then
begin
px := AnimalCorners.x1 + Round((AnimalCorners.x2 - AnimalCorners.x1)/2);
py := AnimalCorners.y1 + Round((AnimalCorners.y2 - AnimalCorners.y1)/2);
Result := True;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Same as above.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function FindCat(x1, y1, x2, y2: integer; Color: TColor): Boolean;
var
x, y, how, value, lastrowvalue, tvalue, countvalue, ones, twoes: integer;
IsLongTail: boolean;
begin
if ((x2 - x1) > (y2 - y1 + 13)) then how := 1
else if ((x2 - x1) < (y2 - y1 + 13)) then how := 2
else how := 3;
IsLongTail := False;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
Result := False;
if (how = 1)then
begin
for x := x1 to x2 do
begin
value := 0;
for y := y1 to y2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 11) then IsLongTail := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 3) and (ones > 0) and (twoes = 2)) or ((ones = 3) and (twoes = 2)) or ((ones = 3) and (twoes = 3)) or ((ones = 2) and (twoes = 3)) or ((ones = 1) and (twoes = 4))) and (IsLongTail) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
if (how = 2) then
begin
for y := y1 to y1 do
begin
value := 0;
for x := x1 to x2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 11) then IsLongTail := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 3) and (ones > 0) and (twoes = 2)) or ((ones = 3) and (twoes = 2)) or ((ones = 3) and (twoes = 3)) or ((ones = 2) and (twoes = 3)) or ((ones = 1) and (twoes = 4))) and (IsLongTail) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:P
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function FindDog(x1, y1, x2, y2: integer; Color: TColor): boolean;
var
x, y,how, value,lastrowvalue, tvalue, countvalue, ones, twoes: integer;
IsDog1, IsDog2: boolean;
begin
if ((x2 - x1) > (y2 - y1 + 13)) then how := 1
else if ((x2 - x1) < (y2 - y1 + 13)) then how := 2
else how := 3;
IsDog1 := False;
IsDog2 := False;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
Result := False;
if (how = 1)then
begin
for x := x1 to x2 do
begin
value := 0;
for y := y1 to y2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 10) then IsDog1 := True;
if (lastrowvalue = 2) and (countvalue > 8) then IsDog2 := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones = 4) and (twoes = 3)) or ((ones = 3) and (twoes = 3)) or ((ones = 3) and (twoes = 2)) or ((ones = 2) and (twoes = 3))) and (not(IsDog1)) and (not(Isdog2)) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
if (how = 2) then
begin
for y := y1 to y1 do
begin
value := 0;
for x := x1 to x2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 20) then tvalue := 2;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 1) and (countvalue > 10) then IsDog1 := True;
if (lastrowvalue = 2) and (countvalue > 8) then IsDog2 := True;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones = 4) and (twoes = 3)) or ((ones = 3) and (twoes = 3)) or ((ones = 3) and (twoes = 2)) or ((ones = 2) and (twoes = 3))) and (not(IsDog1)) and (not(Isdog2)) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
^^
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function FindSheep(var x1, y1, x2, y2: integer; Color: TColor): boolean;
var
x, y, how, value, lastrowvalue, tvalue, countvalue,
ones, twoes: integer;
IsBigBody: boolean;
begin
if ((x2 - x1) > (y2 - y1 + 13)) then how := 1
else if ((x2 - x1) < (y2 - y1 + 13)) then how := 2
else how := 3;
IsBigBody := False;
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
Result := False;
if (how = 1)then
begin
for x := x1 to x2 do
begin
value := 0;
for y := y1 to y2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 15) then tvalue := 2;
if (value > 15) and (value < 45) then tvalue := 3;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) or not(tvalue <> 3) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 2) and (countvalue > 11) then IsBigBody := True;
if (lastrowvalue = 2) and (countvalue > 27) then IsBigBody := False;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 4) and (ones > 0)) and ((twoes > 0) and(twoes < 3))) and (IsBigBody) and ((y2 - y1) < 27) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
if (how = 2) then
begin
for y := y1 to y2 do
begin
value := 0;
for x := x1 to x2 do
if (c[x][y] = Color) then inc(value);
tvalue := 0;
if (value <= 5) and (value > 0) then tvalue := 1;
if (value > 5) and (value < 15) then tvalue := 2;
if (value > 15) and (value < 45) then tvalue := 3;
if not(tvalue <> 1) or not(tvalue <> 2) or not(tvalue <> 0) or not(tvalue <> 3) then
begin
if (lastrowvalue = tvalue) then
begin
inc(countvalue);
end else
begin
if (countvalue <> 0) and (lastrowvalue <> 0) then
begin
if (countvalue > 2) or (lastrowvalue = 2) then
begin
if (lastrowvalue = 1) then inc(ones);
if (lastrowvalue = 2) and (countvalue > 11) then IsBigBody := True;
if (lastrowvalue = 2) and (countvalue > 27) then IsBigBody := False;
if (lastrowvalue = 2) then inc(twoes);
end;
countvalue := 1;
lastrowvalue := tvalue;
end;
end;
end;
end;
if (((ones < 4) and (ones > 0)) and ((twoes > 0) and(twoes < 3))) and (IsBigBody) and ((x2 - x1) < 27)then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := True;
end;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Main loop (ground detecting)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
var
t: TLazIntfImage;
begin
w := 516; h := 338;
Bmp := TBitmap.Create;
Bmp.Width := w;
Bmp.Height:= h;
Bmp.PixelFormat := pf32bit;
SetLength(c, w + 1, h + 1);
BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 0, 0, SRCCOPY);
Result := False;
//finding animals and coloring red
t := bmp.CreateIntfImage;
try
for y := 4 to h - 4 do
for x := 4 to w - 4 do
begin
c[x][y] := RGB(t.Colors[x, y].red, t.Colors[x, y].green, t.Colors[x, y].blue);
if ((t.Colors[x, y].green <> 0) and (t.Colors[x, y].red > 150) and (t.Colors[x, y].green < 120) and (t.Colors[x, y].blue > 120)) then
c[x][y] := clred
else
c[x][y] := 0;
end;
finally
t.Free;
end;
Found1 := False;
for y := 4 to h - 4 do
for x := 4 to w - 4 do
if (c[x][y] = clred) then
begin
if not Found1 then
begin
AnimalCorners.x1 := w - 4;
AnimalCorners.x2 := 4;
AnimalCorners.y1 := h - 4;
AnimalCorners.y2 := 4;
FloodFillAndFindAnimalBoxCoords(x, y, clred, clyellow);
case AnimalId of
1: if FindGoat(clyellow) then Found1 := True;
2: if FindSheep(AnimalCorners.x1, AnimalCorners.y1, AnimalCorners.x2, AnimalCorners.y2, clyellow) then Found1 := True;
3: if FindCat(AnimalCorners.x1, AnimalCorners.y1, AnimalCorners.x2, AnimalCorners.y2, clyellow) then Found1 := True;
4: if FindDog(AnimalCorners.x1, AnimalCorners.y1, AnimalCorners.x2, AnimalCorners.y2, clyellow) then Found1 := True;
end;
end;
end;
Bmp.Free;
if Found1 then Result := True;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End of Prison Pete solver.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 1;
end;
function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall; export;
begin
case x of
0: begin
ProcAddr := @Pete_FindAnimal2;
StrPCopy(ProcDef, 'function Pete_FindAnimal2(var px, py: Integer; AnimalId: Integer; ClientHDC: HDC): Boolean;');
end;
else
x := -1;
end;
Result := x;
end;
exports GetFunctionCount;
exports GetFunctionInfo;
initialization
end.
