SCAR Code:
library IrokiPlugin;
uses
FastShareMem,
SysUtils,
Classes,
Windows,
Math,
Graphics;
{$R *.res}
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);
type
TSCARPlugFunc = record
Name: string;
Ptr: Pointer;
end;
TOneStrProc = procedure(s: string);
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;
TFill = record
Width, Height, Area,
MidX, MidY, x1, y1, groups,
x2, y2: Integer;
end;
var
Writeln: TOneStrProc;
GetClientWindowHandle: TSCARWindowHandle;
var
c: array of array of Integer;
b: array of array of Boolean;
area, bitsize, bgcolor, fillcolor,
w, h, x1, y1, x2, y2, xx, yy: Integer;
animx1, animy1, animx2, animy2: integer;
FillInfo: Boolean;
procedure ScanFill(x, y: Integer); stdcall;
var
i: integer;
begin
if (c[x][y] <> bgcolor) then exit;
c[x][y] := fillcolor;
b[x][y] := True;
area := area + 1;
xx := 0;
yy := 0;
xx := x + 1;
while (xx < W) and (C[xx][y] = bgColor)and
(not(B[xx][y])) do
begin
c[xx][y] := fillcolor;
b[xx][y] := True;
Area := area + 1;
xx := xx + 1;
end;
if (xx - x > 1) then ScanFill(xx, y);
xx := x - 1;
while (xx > 1) and (C[xx][y] = bgColor) and
(not(B[xx][y])) do
begin
c[xx][y] := fillcolor;
b[xx][y] := True;
Area := area + 1;
xx := xx - 1;
end;
if (x - xx > 1) then ScanFill(xx, y);
yy := y + 1;
while (yy < H) and (C[x][yy] = bgColor) and
(not(B[x][yy])) do
begin
c[x][yy] := fillcolor;
b[x][yy] := True;
Area := area + 1;
yy := yy + 1;
end;
if (yy - y > 1) then ScanFill(x, yy);
yy := y - 1;
while (yy > 1) and (C[x][yy] = bgColor) and
(not(B[x][yy])) do
begin
c[x][yy] := fillcolor;
b[x][yy] := True;
Area := area + 1;
yy := yy - 1;
end;
if (y - yy > 1) then ScanFill(x, yy);
for i:= 0 to bitsize do
if (x + ax[i] > 0) and (x + ax[i] < w) and
(y + ay[i] > 0) and (y + ay[i] < h) then
if (not(B[x + ax[i]][y + ay[i]])) and
(c[x + ax[i]][y + ay[i]] = bgcolor) then
ScanFill(x + ax[i], y + ay[i]);
end;
procedure FFillBg(x, y: Integer); stdcall;
var
i: integer;
begin
c[x][y] := fillcolor;
area := area + 1;
for i:= 0 to bitsize do
if (x + ax[i] > 0) and (x + ax[i] < w) and
(y + ay[i] > 0) and (y + ay[i] < h) then
if (c[x + ax[i]][y + ay[i]] = bgcolor) then
begin
FFillBg(x + ax[i], y + ay[i]);
end
end;
{
Prison-Pete solver
By: ManFromCzech, edited by NAQ
}
function Pete_AnalyzeAnimal( var AnimalName: string; ClientHDC: HDC): Boolean; stdcall;
var
BMP2: TBitmap;
x, y, MaxArea, Pixels, i,
fx, fy, Holes, MinDist,
mx, my, Dist, HistoArea: Integer;
HG: array [0..1000] of Integer;
Done: Boolean;
st, lum1, lum2: Extended;
Line: PRGB32Array;
label Lab1;
begin
Result := False;
AnimalName := 'unknow';
w := 460; h := 330;
Bmp2 := TBitmap.Create;
Bmp2.Width := w;
Bmp2.Height:= h;
Bmp2.PixelFormat := pf32bit;
SetLength(c, w + 1, h + 1);
SetLength(b, w + 1, h + 1);
bitsize := 7;
st := Now;
Done := false;
fx := 0; fy := 0;
dec(w); dec(h);
lum2 := 0; lum1 := 0;
repeat
BitBlt(Bmp2.Canvas.Handle, 0, 0, w, h, ClientHDC, 60, 20, SRCCOPY);
fillchar(HG, sizeof(HG), 0);
for y := 0 to h do
begin
Line := bmp2.ScanLine[y];
for x := 0 to w do
begin
c[x][y] := RGB(Line[x].R, Line[x].G, Line[x].B);
b[x][y] := false;
if (Line[x].G <> 0) then
begin
Lum1 := (Line[x].G * 3);
Lum2 := (Line[x].R + Line[x].B);
end else c[x][y] := 0;
if ((lum2 / lum1) < 1.2) then c[x][y] := 0;
with Line[x] do
inc(HG[round(Sqrt(R*R + G*G + B*B))]);
end;
end;
try
for y := 0 to h do
for x := 0 to w do
if (not(b[x][y])) and (c[x][y] <> 0) then
begin
bgcolor := c[x][y];
fillcolor := c[x][y];
Area := 0;
ScanFill(x, y);
if (Area > 180) then
begin
fillcolor := 0;
FFillBg(x, y);
end;
end;
except end;
x1 := w;
y1 := h;
x2 := 0;
y2 := 0;
for y := 5 to h-5 do
for x := 5 to w-5 do
if (c[x][y] <> 0) then
begin
if (x < x1) then x1 := x - 5;
if (y < y1) then y1 := y;
if (x > x2) then x2 := x + 5;
if (y > y2) then y2 := y;
end;
if ((x2 - x1) >= 50) and ((y2 - y1) >= 30) then Done := True;
Sleep(100);
until (((Now - st) * 86400000) > 15000) or (Done);
if (not(done)) then goto lab1;
for y := y1 to y2 do
for x := x1 to x2 do
if (c[x][y] > 0) then
begin
b[x][y] := false;
c[x][y] := clwhite;
end;
bgcolor := clwhite;
fillcolor := clblue;
MaxArea := 0;
fx := 0;
fy := 0;
for y := y1 to y2 do
for x := x1 to x2 do
if (c[x][y] = clwhite) then
begin
Area := 0;
FFillBg(x, y);
if (MaxArea < Area) then
begin
MaxArea := Area;
fx := x;
fy := y;
end;
end;
Area := 0;
bgcolor := clblue;
fillcolor := clred;
FFillBg(fx, fy);
Pixels := Area;
if (Pixels < 4000) then goto lab1;
bmp2.canvas.brush.color := 0;
bmp2.Canvas.Brush.Style := bsSolid;
bmp2.Canvas.Rectangle(0, 0, w, h);
for y := 0 to h do
for x := 0 to w do
begin
if (C[x][y] = clblue) then c[x][y] := 0;
if (c[x][y] = 255) then bmp2.Canvas.Pixels[x, y] := c[x][y];
end;
bmp2.Canvas.Brush.Color := 10;
bmp2.Canvas.FloodFill(3, 3, 0, fsSurface);
bmp2.Canvas.FloodFill(w - 3, h - 3, 0, fsSurface);
for y := 0 to h do
for x := 0 to w do
c[x][y] := bmp2.Canvas.Pixels[x, y];
Holes := 0;
BgColor := 0;
FillColor := clpurple;
for y := y1 to y2 do
for x := x1 to x2 do
if (c[x][y] = 0) then
begin
Area := 0;
FFillBg(x, y);
if (Area > 100) then
Holes := Holes + 1;
end;
x := 0;
HistoArea := 0;
for i:= 1000 downto 0 do
if (HG[i] > 0) then
begin
HistoArea := HistoArea + HG[i];
inc(x);
if x > 20 then
break;
end;
HistoArea := round(HistoArea / 10);
for y := y1 to y2 do
for x := x1 to x2 do
if (c[x][y] = clred) and (not(b[x][y])) then
for i := 0 to 7 do
begin
c[x + ax[i]][y + ay[i]] := clred;
b[x + ax[i]][y + ay[i]] := true;
end;
mx := 0;
my := 0;
area := 0;
for y := y1 to y2 do
for x := x1 to x2 do
if (c[x][y] = clred) then
begin
for i := 0 to 7 do
if (c[x + ax[i]][y + ay[i]] = 10) then
c[x + ax[i]][y + ay[i]] := clwhite;
mx := mx + x;
my := my + y;
area := area + 1;
end;
mx := round(mx / area);
my := round(my / area);
c[mx][my] := clgreen;
for i := 0 to 7 do
c[mx + ax[i]][my + ay[i]] := clgreen;
MinDist := 500;
for y := y1 to y2 do
for x := x1 to x2 do
if (c[x][y] = clwhite) then
begin
Dist := Round(Sqrt(Sqr(x - mx) + Sqr(y - my)));
if (MinDist > Dist) then
begin
MinDist := Dist;
fx := x;
fy := y;
end;
end;
c[fx][fy] := clpurple;
for i := 0 to 7 do
if (c[fx + ax[i]][fy + ay[i]] <> 0) then
c[fx + ax[i]][fy + ay[i]] := clpurple;
x := 0;
HistoArea := 0;
for i:= 1000 downto 0 do
if (HG[i] > 0) then
begin
HistoArea := HistoArea + HG[i];
inc(x);
if x > 15 then
break;
end;
if (Pixels > 22500) then AnimalName := 'goat';
if ((Pixels > 16000) and (Pixels < 22000)) then AnimalName := 'cat';
if ((Pixels > 15000) and (Pixels < 22000)) and (MinDist > 35) then AnimalName := 'sheep';
if ((Pixels > 12500) and (Pixels <= 16000)) and (MinDist > 10) then AnimalName := 'dog';
if (not(AnimalName = 'unknow')) then
begin
Result := True;
goto Lab1;
end;
Lab1:
bmp2.free;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function Pete_FindAnimal(var px, py: Integer; AnimalName: String; ClientHDC: HDC): Boolean; stdcall;
var
BMP: TBitmap;
Line: PRGB32Array;
x, y, BRPixels, BPixels, RPixels: Integer;
Lum1, Lum2: extended;
FoundAnim, FoundAnimal: Boolean;
procedure CountBRPixels(var x1, y1, x2, y2: integer);
var
a, b: integer;
begin
BRPixels := 0;
RPixels := 0;
BPixels := 0;
for b := (y1 + 1) to (y2 - 1) do
begin
for a := (x1 + 1) to (x2 - 1) do
begin
if (c[a][b] = clred) then inc(RPixels);
if (c[a][b] = clred) and (c[a + 1][b] = 0) then inc(BRPixels);
if (c[a][b] = clred) and (c[a - 1][b] = 0) then inc(BRPixels);
if (c[a][b] = clred) and (c[a][b + 1] = 0) then inc(BRPixels);
if (c[a][b] = clred) and (c[a][b - 1] = 0) then inc(BRPixels);
end;
end;
end;
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
//Finding cat
procedure FindCat(var x1, y1, x2, y2: integer);
var
x, y, z, v, how, value, lastrowvalue, tvalue, countvalue, ones, twoes: integer;
IsLongTail: boolean;
begin
x := x1; y := y1; z := x2; v := y2;
if ((z - x) >= ((v - y) + 15)) then how := 1 else if (((z - x) + 15) <= (v - y)) then how := 2 else how := 3;
IsLongTail := False;
if (how = 1)then
begin
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for x := x1 to z do
begin
value := 0;
for y := y1 to v do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
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
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for y := y1 to v do
begin
value := 0;
for x := x1 to z do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
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 = 3) then
for y := y1 to v do
for x := x1 to z do b[x][y] := True;
end;
////////////////////////////////////////////////////////////////////////////////
//Finding dog
procedure FindDog(var x1, y1, x2, y2: integer);
var
x, y, z, v, how, value, lastrowvalue, tvalue, countvalue, ones, twoes: integer;
IsDog1, IsDog2: boolean;
begin
x := x1; y := y1; z := x2; v := y2;
if ((z - x) >= ((v - y) + 15)) then how := 1 else if (((z - x) + 15) <= (v - y)) then how := 2 else how := 3;
IsDog1 := False;
IsDog2 := False;
if (how = 1)then
begin
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for x := x1 to z do
begin
value := 0;
for y := y1 to v do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
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);
end;
end;
if (how = 2) then
begin
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for y := y1 to v do
begin
value := 0;
for x := x1 to z do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
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;
////////////////////////////////////////////////////////////////////////////////
//Finding goat
procedure FindGoat(var x1, y1, x2, y2: integer);
begin
Area := 0;
ScanFill(x, y);
if (Area > 210) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := true;
end;
end;
////////////////////////////////////////////////////////////////////////////////
//Finding sheep
procedure FindSheep(var x1, y1, x2, y2: integer);
var
x, y, z, v, how, value, lastrowvalue, tvalue, countvalue,
ones, twoes, xxis, yyis: integer;
IsBigBody: boolean;
begin
x := x1; y := y1; z := x2; v := y2;
if ((z - x) >= ((v - y) + 13)) then how := 1 else if (((z - x) + 13) <= (v - y)) then how := 2 else how := 3;
IsBigBody := False;
xxis := z - x;
yyis := v - y;
if (how = 1)then
begin
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for x := x1 to z do
begin
value := 0;
for y := y1 to v do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
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 (yyis < 27) then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := true;
end;
end;
if (how = 2) then
begin
lastrowvalue := 1;
countvalue := 0;
ones := 0;
twoes := 0;
FoundAnimal := False;
for y := y1 to v do
begin
value := 0;
for x := x1 to z do
begin
if (c[x][y] = clred) then inc(value);
b[x][y] := True;
end;
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 (xxis < 27)then
begin
px := x1 + Round((x2 - x1)/2);
py := y1 + Round((y2 - y1)/2);
Result := true;
end;
end;
end;
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
Procedure AnimalCorners(x, y: integer);
var
sx, sy: Integer;
Found: Boolean;
begin
//animy1
animy1 := y;
//animx1
Found := False;
for sx := x - 25 to x do
for sy := y + 35 downto y do
if (x - 9 >= 0) then
if (y + 9 <= w) then
begin
if (c[sx][sy] = clred) and not (Found) then
begin
animx1 := sx - 1;
Found := True;
end;
end;
//animy2
Found := False;
for sy := y + 35 downto y do
for sx := x + 25 downto animx1 do
if (x + 9 <= h) then
if (y + 9 <= w) then
begin
if (c[sx][sy] = clred) and not (Found) then
begin
animy2 := sy + 1;
Found := True;
end;
end;
//animx2
Found := False;
for sx := x + 25 downto x do
for sy := animy1 to animy2 do
if (x + 9 <= h) then
begin
if (c[sx][sy] = clred) and not (Found) then
begin
animx2 := sx + 1;
Found := True;
end;
end;
end;
begin
w := 515; h := 337;
Bmp := TBitmap.Create;
Bmp.Width := w;
Bmp.Height:= h;
Bmp.PixelFormat := pf32bit;
SetLength(c, w + 1, h + 1);
SetLength(b, w + 1, h + 1);
bitsize := 7;
BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 4, 4, SRCCOPY);
Result := False;
lum2 := 0; lum1 := 0;
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) then
begin
Lum1 := (Line[x].G * 3);
Lum2 := (Line[x].R + Line[x].B);
end else c[x][y] := 0;
if ((lum2 / lum1) < 1.2) then c[x][y] := 0;
end;
end;
// finding animals and coloring red
for y := 4 to h - 4 do
for x := 4 to w - 4 do
if (c[x][y] <> 0) then
begin
c[x][y] := clred;
b[x][y] := False;
end;
FoundAnim := False;
for y := 4 to h - 40 do
for x := 30 to w - 30 do
if (c[x][y] = clred) and not(b[x][y]) and not(FoundAnim)then
begin
BgColor := c[x][y];
FillColor := c[x][y];
b[x][y] := True;
Area := 0;
ScanFill(x, y);
if (Area > 20) then
begin
AnimalCorners(x, y);
CountBRPixels(animx1, animy1, animx2, animy2);
if (AnimalName = 'cat') then FindCat(animx1, animy1, animx2, animy2);
if (AnimalName = 'dog') then FindDog(animx1, animy1, animx2, animy2);
if (AnimalName = 'goat') then
begin
if (RPixels > 225) and (RPixels < 1000) then
begin
px := (animx1 + round((animx2 - animx1) / 2));
py := (animy1 + round((animy2 - animy1) / 2));
Result := true;
end;
end;
if (AnimalName = 'sheep') and (RPixels < 180) then FindSheep(animx1, animy1, animx2, animy2);
end;
end;
Bmp.Free;
end;
{
Mime solver
By: ManFromCzech
}
function Mime_AnalyzeAnimation(ClientHDC: HDC): string; stdcall;
var
BMP: TBitmap;
Line: PRGB32Array;
Sx1, Sy1, Sx2, Sy2, ObjectArea, x, y, CoMax, CoMin,
BlackArea, BMaxArea, BMinArea, sx, sy, a1, a2, b1, b2, BArea: integer;
Start, Stop, Freq: int64;
Time: double;
Obj: string;
Lum: extended;
begin
a1 := 0; b1 := 0; a2 := 0; b2 := 0;
CoMax := 0; CoMin := 20000; BMinArea := 0; BMaxArea := 20000;
Sx1 := 300; Sx2 := 410; Sy1 := 100; Sy2 := 200;
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(Start);
repeat
w := 430; h := 210;
Bmp := TBitmap.Create;
Bmp.Width := w;
Bmp.Height:= h;
Bmp.PixelFormat := pf32bit;
SetLength(c, w + 1, h + 1);
SetLength(b, w + 1, h + 1);
BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 0, 0, SRCCOPY);
BlackArea := 0;
for y := Sy1 to Sy2 do
begin
Line := bmp.ScanLine[y];
for x := Sx1 to Sx2 do
begin
c[x][y] := RGB(Line[x].R, Line[x].G, Line[x].B);
if (Line[x].R <> 0) then
begin
if (Line[x].R < 190) and (Line[x].G < 180) and (Line[x].B < 170) then
begin
c[x][y] := 0;
b[x][y] := True;
inc(BlackArea);
end;
end else
begin
c[x][y] := 0;
b[x][y] := True;
inc(BlackArea);
end;
end;
end;
ObjectArea := (11211 - BlackArea);
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
for sx := Sx2 - 1 downto Sx1 + 1 do
for sy := Sy1 + 1 to Sy2 - 1 do
begin
if (c[sx][sy] <> 0) then
begin
a2 := sx;
break;
end;
end;
for sx := Sx1 + 1 to Sx2 - 1 do
for sy := Sy1 + 1 to Sy2 - 1 do
begin
if (c[sx][sy] <> 0) then
begin
a1 := sx;
break;
end;
end;
for sy := Sy2 - 1 downto Sy1 + 1 do
for sx := Sx1 + 1 to Sx2 - 1 do
begin
if (c[sx][sy] <> 0) then
begin
b2 := sy;
break;
end;
end;
for sy := Sy1 + 1 to Sy2 - 1 do
for sx := Sx1 + 1 to Sx2 - 1 do
begin
if (c[sx][sy] <> 0) then
begin
b1 := sy;
break;
end;
end;
BArea := (a2 - a1)*(b2 - b1);
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
if (ObjectArea > CoMax) then
begin
CoMax := ObjectArea;
BMaxArea := BArea;
end;
if (ObjectArea < CoMin) then
begin
CoMin := ObjectArea;
BMinArea := BArea;
end;
Bmp.Free;
QueryPerformanceCounter(Stop);
Time := (1E3 * (Stop - Start) / Freq);
Until (Time >= 2500);
Lum := 0;
if (CoMax <> 0) then Lum := (BMaxArea/CoMax);
Obj := 'unknow';
if (Obj = 'unknow') then
if InRange(Lum, 1.8, 2.6) and InRange(BMaxArea, 220, 350) and InRange(BMinArea, 50, 250) and InRange(CoMax, 50, 170) and InRange(CoMin , 0, 60) then Obj := 'Laugh';
if (Obj = 'unknow') then
if InRange(Lum, 1.9, 3.2) and InRange(BMaxArea, 190, 350) and InRange(BMinArea, 150, 550) and InRange(CoMax, 70, 150) and InRange(CoMin , 30, 100) then Obj := 'Think';
if (Obj = 'unknow') then
if InRange(Lum, 2.5, 4.9) and InRange(BMaxArea, 250, 350) and InRange(BMinArea, 20, 100) and InRange(CoMax, 50, 110) and InRange(CoMin , 0, 40) then Obj := 'Cry';
if (Obj = 'unknow') then
if InRange(Lum, 3.0, 6.7) and InRange(BMaxArea, 250, 550) and InRange(BMinArea, 300, 510) and InRange(CoMax, 60, 110) and InRange(CoMin , 40, 90) then Obj := 'Lean on air';
if (Obj = 'unknow') then
if InRange(Lum, 5.2, 7.9) and InRange(BMaxArea, 500, 870) and (InRange(BMinArea, 90, 330) or InRange(BMinArea, 400, 750)) and InRange(CoMax, 100, 150) and InRange(CoMin , 20, 100) then Obj := 'Glass Box';
if ((Obj = 'unknow') or (Obj = 'Glass Box')) then
if InRange(Lum, 3.2, 5.7) and InRange(BMaxArea, 550, 800) and InRange(BMinArea, 40, 350) and InRange(CoMax, 50, 250) and InRange(CoMin , 0, 100) then Obj := 'Dance';
if (Obj = 'unknow') then
if InRange(Lum, 2.5, 4.5) and InRange(BMaxArea, 250, 350) and InRange(BMinArea, 80, 250) and InRange(CoMax, 60, 130) and InRange(CoMin , 30, 70) then Obj := 'Climb Rope';
if (Obj = 'unknow') then Obj := 'Glass Wall';
Result := Obj;
end;
{
Mr.Mordaut plugin
By: ManFromCzech, useful idea by NaumanAkhlaQ
}
function Mordaut_GetSlotNr(ScanningTime: Extended; ClientHDC: HDC): integer; stdcall;
var
BMP: TBitmap;
Line: PRGB32Array;
Sx1, Sy1, Sx2, Sy2, x, y, sx, sy, a1, a2, b1, b2, Slot, i: integer;
Start, Stop, Freq: int64;
Time: double;
ObjToFind: string;
Obj: array of string;
Lum: array of extended;
CoMax: array of Integer;
CoMin: array of Integer;
BMaxArea: array of Integer;
BMinArea: array of Integer;
BArea: array of Integer;
BlackArea: array of Integer;
ObjectArea: array of Integer;
cM: array of array of array of Integer;
bM: array of array of array of Boolean;
begin
SetLength(Obj, 7);
SetLength(Lum, 7);
SetLength(CoMax, 7);
SetLength(CoMin, 7);
SetLength(BMaxArea, 7);
SetLength(BMinArea, 7);
SetLength(BArea, 7);
SetLength(BlackArea, 7);
SetLength(ObjectArea, 7);
for Slot := 0 to 6 do
begin
CoMax[Slot] := 0; CoMin[Slot] := 2000; BMaxArea[Slot] := 0; BMinArea[Slot] := 0;
BArea[Slot] := 0;
end;
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(Start);
Sx1 := 0; Sy1 := 0; Sx2 := 0; Sy2 := 0; a1 := 0; a2 := 0; b1 := 0; b2 := 0;
repeat
w := 456; h := 291;
Bmp := TBitmap.Create;
Bmp.Width := w;
Bmp.Height:= h;
Bmp.PixelFormat := pf32bit;
SetLength(cM, w + 1, h + 1, 7);
SetLength(bM, w + 1, h + 1, 7);
BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 0, 0, SRCCOPY);
for Slot := 0 to 6 do
begin
BlackArea[Slot] := 0;
//////////////////////
{
Slots:
_________________________________
| ______ ______ ______ |
| | | | | |
| | 0 | 1 | 2 | |
| |______|______|______| |
| |
| What comes next? |
| ______ ______ ______ ______ |
| | | | | | |
| | 3 | 4 | 5 | 6 | |
| |______|______|______|______| |
|_________________________________|
}
case Slot of
0, 1, 2: begin
Sx1 := 55 + Slot*100;
Sy1 := 45;
Sx2 := Sx1 + 100;
Sy2 := 145;
end;
3, 4, 5, 6: begin
Sx1 := -245 + Slot*100;
Sy1 := 190;
Sx2 := Sx1 + 100;
Sy2 := 290;
end;
end;
for y := Sy1 to Sy2 do
begin
Line := bmp.ScanLine[y];
for x := Sx1 to Sx2 do
begin
cM[x][y][Slot] := RGB(Line[x].R, Line[x].G, Line[x].B);
if (Line[x].R <> 0) then
begin
if InRange(Line[x].R, 65, 95) then
if InRange(Line[x].G, 80, 115) then
if InRange(Line[x].B, 65, 95)then
begin
cM[x][y][Slot] := 0;
bM[x][y][Slot] := True;
inc(BlackArea[Slot]);
end;
end else
begin
cM[x][y][Slot] := 0;
bM[x][y][Slot] := True;
inc(BlackArea[Slot]);
end;
end;
end;
ObjectArea[Slot] := (10201 - BlackArea[Slot]);
for sx := Sx2 - 1 downto Sx1 + 1 do
for sy := Sy1 + 1 to Sy2 - 1 do
begin
if (cM[sx][sy][Slot] <> 0) then
begin
a2 := sx;
break;
end;
end;
for sx := Sx1 + 1 to Sx2 - 1 do
for sy := Sy1 + 1 to Sy2 - 1 do
begin
if (cM[sx][sy][Slot] <> 0) then
begin
a1 := sx;
break;
end;
end;
for sy := Sy2 - 1 downto Sy1 + 1 do
for sx := Sx1 + 1 to Sx2 - 1 do
begin
if (cM[sx][sy][Slot] <> 0) then
begin
b2 := sy;
break;
end;
end;
for sy := Sy1 + 1 to Sy2 - 1 do
for sx := Sx1 + 1 to Sx2 - 1 do
begin
if (cM[sx][sy][Slot] <> 0) then
begin
b1 := sy;
break;
end;
end;
BArea[Slot] := (a2 - a1)*(b2 - b1);
if (ObjectArea[Slot] > CoMax[Slot]) then
begin
CoMax[Slot] := ObjectArea[Slot];
BMaxArea[Slot] := BArea[Slot];
end;
if (ObjectArea[Slot] < CoMin[Slot]) then
begin
CoMin[Slot] := ObjectArea[Slot];
BMinArea[Slot] := BArea[Slot];
end;
//////////////
end;
Bmp.Free;
QueryPerformanceCounter(Stop);
Time := (1E3 * (Stop - Start) / Freq);
Until (Time >= (ScanningTime * 1000));
for Slot := 0 to 6 do
begin
if (CoMax[Slot] <> 0 ) then Lum[Slot] := (BMaxArea[Slot]/CoMax[Slot]);
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~ Objects database ~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Obj[Slot] := 'unknow';
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (Slot = 0) then
begin
if InRange(Lum[Slot], 1.3, 1.9) and InRange(BMaxArea[Slot], 700, 1200) and InRange(BMinArea[Slot], 340, 650) and InRange(CoMax[Slot], 580, 730)
and InRange(CoMin[Slot], 300, 460) then Obj[Slot] := 'Q18'; // Boots
if InRange(Lum[Slot], 1.35, 1.9) and InRange(BMaxArea[Slot], 100, 1350) and InRange(BMinArea[Slot], 300, 900) and InRange(CoMax[Slot], 700, 775)
and InRange(CoMin[Slot], 115, 270) then Obj[Slot] := 'Q03'; // Thieve mask
if InRange(Lum[Slot], 2.7, 4.9) and InRange(BMaxArea[Slot], 800, 1400) and InRange(BMinArea[Slot], 0, 160) and InRange(CoMax[Slot], 280, 360)
and InRange(CoMin[Slot], 20, 80) then Obj[Slot] := 'Q02'; // Scimitar
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (Slot = 1) then
begin
if InRange(Lum[Slot], 1.0, 1.5) and InRange(BMaxArea[Slot], 800, 1200) and InRange(BMinArea[Slot], 120, 250) and InRange(CoMax[Slot], 750, 820)
and InRange(CoMin[Slot], 60, 200) then Obj[Slot] := 'Q20'; // Wooden shield
if InRange(Lum[Slot], 1.5, 2.8) and InRange(BMaxArea[Slot], 1000, 1550) and InRange(BMinArea[Slot], 200, 450) and InRange(CoMax[Slot], 500, 670)
and InRange(CoMin[Slot], 180, 320) then Obj[Slot] := 'Q19'; // Ore
if InRange(Lum[Slot], 1.4, 2.2) and InRange(BMaxArea[Slot], 820, 1000) and InRange(BMinArea[Slot], 320, 700) and InRange(CoMax[Slot], 440, 540)
and InRange(CoMin[Slot], 250, 330) then Obj[Slot] := 'Q17'; // Full helmet
if InRange(Lum[Slot], 0.95, 1.45) and InRange(BMaxArea[Slot], 1000, 1400) and InRange(BMinArea[Slot], 450, 700) and InRange(CoMax[Slot], 900, 1100)
and InRange(CoMin[Slot], 440, 600) then Obj[Slot] := 'Q16'; // Cake
if InRange(Lum[Slot], 0.9, 1.4) and InRange(BMaxArea[Slot], 250, 380) and InRange(BMinArea[Slot], 220, 300) and InRange(CoMax[Slot], 240, 320)
and InRange(CoMin[Slot], 150, 200) then Obj[Slot] := 'Q15'; // Garlic
if InRange(Lum[Slot], 1.2, 4.0) and InRange(BMaxArea[Slot], 200, 560) and InRange(BMinArea[Slot], 20, 360) and InRange(CoMax[Slot], 130, 170)
and InRange(CoMin[Slot], 10, 120) then Obj[Slot] := 'Q13'; // Shrimp
if InRange(Lum[Slot], 1.4, 1.7) and InRange(BMaxArea[Slot], 510, 610) and InRange(BMinArea[Slot], 290, 410) and InRange(CoMax[Slot], 330, 410)
and InRange(CoMin[Slot], 210, 260) then Obj[Slot] := 'Q11'; // Strawberry
if InRange(Lum[Slot], 1.15, 1.4) and InRange(BMaxArea[Slot], 1150, 1300) and InRange(BMinArea[Slot], 380, 520) and InRange(CoMax[Slot], 900, 950)
and InRange(CoMin[Slot], 380, 460) then Obj[Slot] := 'Q09'; // Fire rune
if InRange(Lum[Slot], 1.45, 2.4) and InRange(BMaxArea[Slot], 700, 1200) and InRange(BMinArea[Slot], 0, 70) and InRange(CoMax[Slot], 465, 515)
and InRange(CoMin[Slot], 0, 50) then Obj[Slot] := 'Q01'; // White approw
if InRange(Lum[Slot], 1.40, 2.2) and InRange(BMaxArea[Slot], 940, 1310) and InRange(BMinArea[Slot], 680, 1000) and InRange(CoMax[Slot], 560, 640)
and InRange(CoMin[Slot], 300, 360) then Obj[Slot] := 'Q06'; // Watering can
if InRange(Lum[Slot], 1.5, 1.9) and InRange(BMaxArea[Slot], 1150, 1380) and InRange(BMinArea[Slot], 200, 500) and InRange(CoMax[Slot], 720, 790)
and InRange(CoMin[Slot], 200, 360) then Obj[Slot] := 'Q07'; // Bar
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (Slot = 2) then
begin
if InRange(Lum[Slot], 1.3, 2.9) and InRange(BMaxArea[Slot], 1100, 2300) and InRange(BMinArea[Slot], 390, 900) and InRange(CoMax[Slot], 770, 870)
and InRange(CoMin[Slot], 250, 460) then Obj[Slot] := 'Q14'; // Monkfish
if InRange(Lum[Slot], 1.0, 1.5) and InRange(BMaxArea[Slot], 800, 1200) and InRange(BMinArea[Slot], 120, 250) and InRange(CoMax[Slot], 750, 820)
and InRange(CoMin[Slot], 60, 200) then Obj[Slot] := 'Q12'; // Wooden shield
if InRange(Lum[Slot], 1.0, 1.3) and InRange(BMaxArea[Slot], 500, 580) and InRange(BMinArea[Slot], 120, 280) and InRange(CoMax[Slot], 420, 490)
and InRange(CoMin[Slot], 35, 90) then Obj[Slot] := 'Q10'; // Rum
if InRange(Lum[Slot], 2.7, 4.65) and InRange(BMaxArea[Slot], 770, 1250) and InRange(BMinArea[Slot], 200, 400) and InRange(CoMax[Slot], 250, 300)
and InRange(CoMin[Slot], 70, 140) then Obj[Slot] := 'Q04'; // Crossbow
if InRange(Lum[Slot], 1.75, 2.9) and InRange(BMaxArea[Slot], 200, 360) and InRange(BMinArea[Slot], 50, 150) and InRange(CoMax[Slot], 120, 140)
and InRange(CoMin[Slot], 50, 70) then Obj[Slot] := 'Q05'; // Candle
if InRange(Lum[Slot], 3.1, 4.0) and InRange(BMaxArea[Slot], 1300, 1700) and InRange(BMinArea[Slot], 80, 120) and InRange(CoMax[Slot], 380, 470)
and InRange(CoMin[Slot], 55, 95) then Obj[Slot] := 'Q08'; // Holy symbol
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if InRange(Slot, 3, 6) then
begin
if InRange(Lum[Slot], 1.2, 1.8) and InRange(BMaxArea[Slot], 1000, 1500) and InRange(BMinArea[Slot], 150, 280) and InRange(CoMax[Slot], 800, 870)
and InRange(CoMin[Slot], 50, 150) then Obj[Slot] := 'Q20'; // Kiteshield
if InRange(Lum[Slot], 1.5, 1.9) and InRange(BMaxArea[Slot], 1150, 1380) and InRange(BMinArea[Slot], 200, 500) and InRange(CoMax[Slot], 720, 790)
and InRange(CoMin[Slot], 200, 360) then Obj[Slot] := 'Q19'; // Bar
if InRange(Lum[Slot], 1.3, 2.0) and InRange(BMaxArea[Slot], 1020, 1300) and InRange(BMinArea[Slot], 380, 670) and InRange(CoMax[Slot], 650, 750)
and InRange(CoMin[Slot], 300, 470) then Obj[Slot] := 'Q17'; // Platebody
if InRange(Lum[Slot], 1.1, 1.35) and InRange(BMaxArea[Slot], 1150, 1350) and InRange(BMinArea[Slot], 400, 600) and InRange(CoMax[Slot], 950, 1050)
and InRange(CoMin[Slot], 300, 370) then Obj[Slot] := 'Q16'; // Apple pie
if InRange(Lum[Slot], 1.05, 2.2) and InRange(BMaxArea[Slot], 350, 1200) and InRange(BMinArea[Slot], 350, 1200) and InRange(CoMax[Slot], 400, 700)
and InRange(CoMin[Slot], 70, 500) then Obj[Slot] := 'Q15'; // Pineapple
if InRange(Lum[Slot], 1.9, 3.1) and InRange(BMaxArea[Slot], 700, 1100) and InRange(BMinArea[Slot], 150, 310) and InRange(CoMax[Slot], 330, 420)
and InRange(CoMin[Slot], 50, 150) then Obj[Slot] := 'Q14'; // Trout
if InRange(Lum[Slot], 3.0, 4.9) and InRange(BMaxArea[Slot], 1050, 1600) and InRange(BMinArea[Slot], 40, 170) and InRange(CoMax[Slot], 310, 380)
and InRange(CoMin[Slot], 30, 100) then Obj[Slot] := 'Q13'; // Swordfish
if InRange(Lum[Slot], 1.4, 2.6) and InRange(BMaxArea[Slot], 1100, 2000) and InRange(BMinArea[Slot], 100, 300) and InRange(CoMax[Slot], 700, 810)
and InRange(CoMin[Slot], 40, 200) then Obj[Slot] := 'Q12'; // Antidragon shield
if InRange(Lum[Slot], 1.5, 2.65) and InRange(BMaxArea[Slot], 300, 620) and InRange(BMinArea[Slot], 10, 110) and InRange(CoMax[Slot], 140, 280)
and InRange(CoMin[Slot], 20, 100) then Obj[Slot] := 'Q11'; // Berry's
if InRange(Lum[Slot], 1.2, 1.45) and InRange(BMaxArea[Slot], 1100, 1300) and InRange(BMinArea[Slot], 380, 520) and InRange(CoMax[Slot], 880, 950)
and InRange(CoMin[Slot], 400, 460) then Obj[Slot] := 'Q09'; // Earth rune
if InRange(Lum[Slot], 1.05, 2.0) and InRange(BMaxArea[Slot], 320, 570) and InRange(BMinArea[Slot], 120, 270) and InRange(CoMax[Slot], 250, 300)
and InRange(CoMin[Slot], 100, 170) then Obj[Slot] := 'Q08'; // Ring
if InRange(Lum[Slot], 1.05, 1.35) and InRange(BMaxArea[Slot], 1050, 1300) and InRange(BMinArea[Slot], 500, 650) and InRange(CoMax[Slot], 950, 1050)
and InRange(CoMin[Slot], 480, 580) then Obj[Slot] := 'Q01'; // Cake
if InRange(Lum[Slot], 2.4, 4.0) and InRange(BMaxArea[Slot], 520, 1050) and InRange(BMinArea[Slot], 200, 800) and InRange(CoMax[Slot], 210, 280)
and InRange(CoMin[Slot], 110, 190) then Obj[Slot] := 'Q02'; // Mace
if InRange(Lum[Slot], 1.7, 2.6) and InRange(BMaxArea[Slot], 760, 1100) and InRange(BMinArea[Slot], 250, 450) and InRange(CoMax[Slot], 400, 480)
and InRange(CoMin[Slot], 110, 190) then Obj[Slot] := 'Q03'; // Jeaster hat
if InRange(Lum[Slot], 1.4, 8.0) and InRange(BMaxArea[Slot], 300, 1250) and InRange(BMinArea[Slot], 0, 200) and InRange(CoMax[Slot], 140, 195)
and InRange(CoMin[Slot], 0, 60) then Obj[Slot] := 'Q04'; // Longbow
if InRange(Lum[Slot], 1.2, 1.75) and InRange(BMaxArea[Slot], 600, 800) and InRange(BMinArea[Slot], 320, 610) and InRange(CoMax[Slot], 400, 600)
and InRange(CoMin[Slot], 200, 310) then Obj[Slot] := 'Q05'; // Bullseye lataren
if InRange(Lum[Slot], 2.3, 3.3) and InRange(BMaxArea[Slot], 720, 1000) and InRange(BMinArea[Slot], 60, 160) and InRange(CoMax[Slot], 280, 340)
and InRange(CoMin[Slot], 45, 100) then Obj[Slot] := 'Q06'; // Gardening trowel
if InRange(Lum[Slot], 3.5, 5.4) and InRange(BMaxArea[Slot], 1020, 1750) and InRange(BMinArea[Slot], 95, 260) and InRange(CoMax[Slot], 270, 340)
and InRange(CoMin[Slot], 70, 160) then Obj[Slot] := 'Q07'; // Pickaxe
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
end;
ObjToFind := 'unknow';
Result := (0);
for i := 0 to 2 do
if (Obj[i] <> 'unknow') then ObjToFind := Obj[i];
if (ObjToFind = 'Q10') then ObjToFind := 'Q08';
if (ObjToFind = 'Q18') then ObjToFind := 'Q15';
if (ObjToFind <> 'unknow') then
begin
for i := 3 to 6 do
begin
if (Obj[i] = ObjToFind) then Result := i;
end;
end else Result := (0);
end;
function Mordaut_GetBigSlotNr(ScanningTime: Extended; QuestionType: string; ClientHDC: HDC): string; stdcall;
var
BMP: TBitmap;
Line: PRGB32Array;
Sx1, Sy1, Sx2, Sy2, x, y, sx, sy, a1, a2, b1, b2, Slot, i, slotscount, ScanningTries: integer;
Start, Stop, Freq: int64;
Time: double;
ObjToFind: string;
Obj: array of string;
Lum: array of extended;
CoMax: array of Integer;
CoMin: array of Integer;
BMaxArea: array of Integer;
BMinArea: array of Integer;
BArea: array of Integer;
BlackArea: array of Integer;
ObjectArea: array of Integer;
slots: string;
IsNeckle: array of Integer;
cM: array of array of array of Integer;
label Scanning;
begin
SetLength(Obj, 16);
SetLength(Lum, 16);
SetLength(CoMax, 16);
SetLength(CoMin, 16);
SetLength(BMaxArea, 16);
SetLength(BMinArea, 16);
SetLength(BArea, 16);
SetLength(BlackArea, 16);
SetLength(ObjectArea, 16);
ScanningTries := 0;
SetLength(IsNeckle, 16);
inc(ScanningTries);
Scanning:
slots := '';
slotscount := 0;
inc(ScanningTries);
for Slot := 0 to 14 do
begin
CoMax[Slot] := 0; CoMin[Slot] := 2000; BMaxArea[Slot] := 0; BMinArea[Slot] := 0;
BArea[Slot] := 0; IsNeckle[Slot] := 0;
end;
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(Start);
Sx1 := 0; Sy1 := 0; Sx2 := 0; Sy2 := 0; a1 := 0; a2 := 0; b1 := 0; b2 := 0;
repeat
w := 372; h := 297;
Bmp := TBitmap.Create;
Bmp.Width := w;
Bmp.Height:= h;
Bmp.PixelFormat := pf32bit;
SetLength(cM, w + 1, h + 1, 16);
BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 0, 0, SRCCOPY);
for Slot := 0 to 14 do
begin
BlackArea[Slot] := 0;
//////////////////////
{
Slots:
_________________________________
| ____ ____ ____ ____ ____ |
| | | | | | | ~~~ |
| | 0 | 1 | 2 | 3 | 4 | ~~~ |
| |____|____|____|____|____| ~~~ |
| | | | | | | |
| | 5 | 6 | 7 | 8 | 9 | |
| |____|____|____|____|____| |
| | | | | | | |
| | 10 | 11 | 12 | 13 | 14 | |
| |____|____|____|____|____| |
|_________________________________|
}
case Slot of
0, 1, 2, 3, 4: begin
Sx1 := 40 + Slot*67;
Sy1 := 35;
Sx2 := Sx1 + 63;
Sy2 := 114;
end;
5, 6, 7, 8, 9: begin
Sx1 := -295 + Slot*67;
Sy1 := 126;
Sx2 := Sx1 + 63;
Sy2 := 205;
end;
10, 11, 12, 13, 14: begin
Sx1 := -630 + Slot*67;
Sy1 := 217;
Sx2 := Sx1 + 63;
Sy2 := 296;
end;
end;
for y := Sy1 to Sy2 do
begin
Line := bmp.ScanLine[y];
for x := Sx1 to Sx2 do
begin
cM[x][y][Slot] := RGB(Line[x].R, Line[x].G, Line[x].B);
if (Line[x].R <> 0) then
begin
if (Line[x].R > 180) then
if (Line[x].G > 200) then
begin
cM[x][y][Slot] := 0;
inc(BlackArea[Slot]);
end;
end else
begin
cM[x][y][Slot] := 0;
inc(BlackArea[Slot]);
end;
end;
end;
ObjectArea[Slot] := (4977 - BlackArea[Slot]);
if ((QuestionType = 'Q02') or (QuestionType = 'Q06')) then
if (IsNeckle[Slot] = 0) then
begin
for y := Sy1 to Sy2 do
begin
if (not(cM[Sx1 + 1][y][Slot] = 0)) then IsNeckle[Slot] := 1;
end;
end;
for sx := Sx2 - 1 downto Sx1 + 1 do
for sy := Sy1 + 1 to Sy2 - 1 do
begin
if (cM[sx][sy][Slot] <> 0) then
begin
a2 := sx;
break;
end;
end;
for sx := Sx1 + 1 to Sx2 - 1 do
for sy := Sy1 + 1 to Sy2 - 1 do
begin
if (cM[sx][sy][Slot] <> 0) then
begin
a1 := sx;
break;
end;
end;
for sy := Sy2 - 1 downto Sy1 + 1 do
for sx := Sx1 + 1 to Sx2 - 1 do
begin
if (cM[sx][sy][Slot] <> 0) then
begin
b2 := sy;
break;
end;
end;
for sy := Sy1 + 1 to Sy2 - 1 do
for sx := Sx1 + 1 to Sx2 - 1 do
begin
if (cM[sx][sy][Slot] <> 0) then
begin
b1 := sy;
break;
end;
end;
BArea[Slot] := (a2 - a1)*(b2 - b1);
if (ObjectArea[Slot] > CoMax[Slot]) then
begin
CoMax[Slot] := ObjectArea[Slot];
BMaxArea[Slot] := BArea[Slot];
end;
if (ObjectArea[Slot] < CoMin[Slot]) then
begin
CoMin[Slot] := ObjectArea[Slot];
BMinArea[Slot] := BArea[Slot];
end;
//////////////
end;
Bmp.Free;
QueryPerformanceCounter(Stop);
Time := (1E3 * (Stop - Start) / Freq);
Until (Time >= (ScanningTime * 1000));
for Slot := 0 to 14 do
begin
if (CoMax[Slot] <> 0) then Lum[Slot] := (BMaxArea[Slot]/CoMax[Slot]);
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~ Objects database ~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Obj[Slot] := 'unknow';
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (QuestionType = 'Q01') then
begin
if InRange(Lum[Slot], 1.6, 1.9) and InRange(BMaxArea[Slot], 810, 1010) and InRange(BMinArea[Slot], 530, 700) and InRange(CoMax[Slot], 480, 600)
and InRange(CoMin[Slot], 170, 290) then Obj[Slot] := 'Q01'; // beer
if InRange(Lum[Slot], 1.9, 2.8) and InRange(BMaxArea[Slot], 630, 900) and InRange(BMinArea[Slot], 300, 670) and InRange(CoMax[Slot], 300, 360)
and InRange(CoMin[Slot], 50, 150) then Obj[Slot] := 'Q01'; // cocktail
if InRange(Lum[Slot], 1.5, 1.7) and InRange(BMaxArea[Slot], 1120, 1360) and InRange(BMinArea[Slot], 630, 910) and InRange(CoMax[Slot], 700, 870)
and InRange(CoMin[Slot], 300, 550) then Obj[Slot] := 'Q01'; // cup of tea
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (QuestionType = 'Q02') then
begin
if InRange(Lum[Slot], 1.5, 1.85) and InRange(BMaxArea[Slot], 1050, 1200) and InRange(BMinArea[Slot], 290, 550) and InRange(CoMax[Slot], 630, 710)
and InRange(CoMin[Slot], 80, 210) then Obj[Slot] := 'Q02'; // pirate hat
if InRange(Lum[Slot], 3.3, 4.2) and InRange(CoMax[Slot], 220, 280) and InRange(CoMin[Slot], -144, -130) and InRange(BMaxArea[Slot], 870, 1020)
then Obj[Slot] := 'Q02'; // eye patch
if InRange(Lum[Slot], 4.9, 8.5) and InRange(BMaxArea[Slot], 620, 1100) and InRange(BMinArea[Slot], 30, 190) and InRange(CoMax[Slot], 100, 170)
and InRange(CoMin[Slot], -110, -10) and (IsNeckle[Slot] = 1) then Obj[Slot] := 'Q02'; // hook
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (QuestionType = 'Q03') then
begin
if InRange(Lum[Slot], 2.6, 4.2) and InRange(BMaxArea[Slot], 370, 600) and InRange(BMinArea[Slot], 100, 210) and InRange(CoMax[Slot], 110, 170)
and InRange(CoMin[Slot], -80, -10) then Obj[Slot] := 'Q03'; // ring
if InRange(Lum[Slot], 4.1, 5.5) and InRange(BMaxArea[Slot], 1300, 1650) and InRange(BMinArea[Slot], 50, 180) and InRange(CoMax[Slot], 270, 350)
and InRange(CoMin[Slot], -90, -40) then Obj[Slot] := 'Q03'; // holy symbol
if InRange(Lum[Slot], 3.9, 7.2) and InRange(BMaxArea[Slot], 620, 920) and InRange(BMinArea[Slot], 30, 130) and InRange(CoMax[Slot], 110, 160)
and InRange(CoMin[Slot], -100, -10) then Obj[Slot] := 'Q03'; // neckle
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (QuestionType = 'Q04') then
begin
if InRange(BMinArea[Slot], 290, 500) and InRange(CoMax[Slot], 120, 180) and InRange(CoMin[Slot], -80, 0) then Obj[Slot] := 'Q04'; // crossbow
if InRange(BMinArea[Slot], 0, 120) and InRange(CoMax[Slot], 10, 70) and InRange(CoMin[Slot], -144, -90) then Obj[Slot] := 'Q04'; // longbow
if (Lum[Slot] > 5.8) and InRange(BMinArea[Slot], 0, 40) and InRange(CoMin[Slot], -144, -90) then Obj[Slot] := 'Q04'; // arrows
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (QuestionType = 'Q05') then
begin
if InRange(Lum[Slot], 1.4, 2.1) and InRange(BMaxArea[Slot], 1050, 1500) and InRange(BMinArea[Slot], 600, 900) and InRange(CoMax[Slot], 680, 750)
and InRange(CoMin[Slot], 220, 440) then Obj[Slot] := 'Q05'; // logs
if InRange(Lum[Slot], 1.6, 2.1) and InRange(BMaxArea[Slot], 730, 820) and InRange(BMinArea[Slot], 320, 540) and InRange(CoMax[Slot], 380, 440)
and InRange(CoMin[Slot], 160, 200) then Obj[Slot] := 'Q05'; // bullseye lantern
if (BMaxArea[Slot] > 1600) and (BMinArea[Slot] > 1000) and (CoMax[Slot] > 1200)
and (CoMin[Slot]> 450) then Obj[Slot] := 'Q05'; // tinderbox
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (QuestionType = 'Q06') then
begin
if InRange(Lum[Slot], 4.9, 6.1) and InRange(BMaxArea[Slot], 790, 960) and InRange(BMinArea[Slot], -1, 100) and InRange(CoMax[Slot], 130, 180)
and InRange(CoMin[Slot], -143, -70) then Obj[Slot] := 'Q06'; // battle axe
if InRange(Lum[Slot], 4.4, 6.2) and InRange(BMaxArea[Slot], 1000, 1400) and InRange(BMinArea[Slot], 10, 140) and InRange(CoMax[Slot], 210, 260)
and InRange(CoMin[Slot], -120, -50) and (IsNeckle[Slot] = 1) then Obj[Slot] := 'Q06'; // scimitar
if InRange(BMinArea[Slot], -1, 60) and InRange(CoMax[Slot], -10, 60)
and InRange(CoMin[Slot], -140, -100) and (IsNeckle[Slot] = 1) then Obj[Slot] := 'Q06'; // sword
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (QuestionType = 'Q07') then
begin
if InRange(Lum[Slot], 1.2, 1.5) and InRange(BMaxArea[Slot], 1120, 1250) and InRange(BMinArea[Slot], 390, 550) and InRange(CoMax[Slot], 820, 920)
and InRange(CoMin[Slot], 270, 370) then Obj[Slot] := 'Q07'; // fire rune
if InRange(Lum[Slot], 1.2, 1.6) and InRange(BMaxArea[Slot], 1120, 1350) and InRange(BMinArea[Slot], 390, 550) and InRange(CoMax[Slot], 830, 940)
and InRange(CoMin[Slot], 250, 370) then Obj[Slot] := 'Q07'; // water rune
if InRange(CoMin[Slot], -130, -80) and (IsNeckle[Slot] = 1) then Obj[Slot] := 'Q07'; // staff
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (QuestionType = 'Q08') then
begin
if InRange(Lum[Slot], 1.6, 2.3) and InRange(BMaxArea[Slot], 1030, 1450) and InRange(BMinArea[Slot], 520, 760) and InRange(CoMax[Slot], 510, 680)
and InRange(CoMin[Slot], -50, 120) then Obj[Slot] := 'Q08'; // hemingway mask
if InRange(Lum[Slot], 1.3, 1.65) and InRange(BMaxArea[Slot], 1050, 1250) and InRange(BMinArea[Slot], 740, 900) and InRange(CoMax[Slot], 690, 830)
and InRange(CoMin[Slot], 400, 530) then Obj[Slot] := 'Q08'; // frog mask
if InRange(Lum[Slot], 1.3, 1.75) and InRange(BMaxArea[Slot], 950, 1200) and InRange(BMinArea[Slot], 380, 650) and InRange(CoMax[Slot], 650, 750)
and InRange(CoMin[Slot], 80, 320) then Obj[Slot] := 'Q08'; // mime mask
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (QuestionType = 'Q09') then
begin
if InRange(Lum[Slot], 2.0, 3.1) and InRange(BMaxArea[Slot], 700, 1020) and InRange(BMinArea[Slot], 200, 620) and InRange(CoMax[Slot], 310, 380)
and InRange(CoMin[Slot], -10, 60) then Obj[Slot] := 'Q09'; // jester hat
if InRange(Lum[Slot], 1.1, 2.0) and InRange(BMaxArea[Slot], 1000, 1400) and InRange(BMinArea[Slot], 430, 580) and InRange(CoMax[Slot], 690, 760)
and InRange(CoMin[Slot], 80, 150) then Obj[Slot] := 'Q09'; // lederhosen hat
if InRange(Lum[Slot], 1.5, 1.85) and InRange(BMaxArea[Slot], 1050, 1200) and InRange(BMinArea[Slot], 290, 550) and InRange(CoMax[Slot], 630, 710)
and InRange(CoMin[Slot], 80, 210) then Obj[Slot] := 'Q09'; // pirate hat
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (QuestionType = 'Q10') then
begin
if InRange(Lum[Slot], 5.9, 11.0) and InRange(BMaxArea[Slot], 700, 1250) and InRange(BMinArea[Slot], 15, 220) and InRange(CoMax[Slot], 80, 140)
and InRange(CoMin[Slot], -130, -70) then Obj[Slot] := 'Q10'; // harpoon
if InRange(Lum[Slot], 2.5, 4.5) and InRange(BMaxArea[Slot], 700, 1200) and InRange(BMinArea[Slot], 120, 300) and InRange(CoMax[Slot], 220, 290)
and InRange(CoMin[Slot], -80, -20) then Obj[Slot] := 'Q10'; // fish
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (Obj[Slot] = QuestionType) then
begin
slots := slots + inttostr(Slot) + ' ';
inc(slotscount);
end;
end;
if ((slotscount <> 3) and (ScanningTries < 10)) then goto Scanning;
if (ScanningTries >= 10) then slots := (IntToStr(Random(5)) + ' ' + IntToStr(4 + Random(5)) + ' ' + IntToStr(9 + Random(5)));
Result := slots;
end;
function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 5;
end;
function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
case x of
0:
begin
ProcAddr := @Pete_AnalyzeAnimal;
StrPCopy(ProcDef, 'function Pete_AnalyzeAnimal( var AnimalName: string; ClientHDC: HDC): Boolean;');
end;
1:
begin
ProcAddr := @Pete_FindAnimal;
StrPCopy(ProcDef, 'function Pete_FindAnimal(var px, py: Integer; AnimalName: String; ClientHDC: HDC): Boolean;');
end;
2:
begin
ProcAddr := @Mime_AnalyzeAnimation;
StrPCopy(ProcDef, 'function Mime_AnalyzeAnimation(ClientHDC: HDC): string;');
end;
3:
begin
ProcAddr := @Mordaut_GetSlotNr;
StrPCopy(ProcDef, 'function Mordaut_GetSlotNr(ScanningTime: Extended; ClientHDC: HDC): integer;');
end;
4:
begin
ProcAddr := @Mordaut_GetBigSlotNr;
StrPCopy(ProcDef, 'function Mordaut_GetBigSlotNr(ScanningTime: Extended; QuestionType: string; ClientHDC: HDC): string;');
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.
//Solver's End Here :)//
//-Iroki and Nauman//