Code:
{$IFDEF SMART}
{$IFNDEF PAINT}
{$DEFINE PAINT}
{$i SRL\SRL\MISC\Paintsmart.simba}
{$ENDIF}
{$ENDIF}
{-------------------------------------------------------------------------------
Object DTM Include
By: euphemism
-This include contains procedures and functions to use and create Object DTMs.
-TO DO: Implement more generating features to ease creation of Object DTMs.
-Version 9.9: Added the function 'ObjDTM_WalkPath'. The include now
contains a function to easily walk paths contained within
TStringArrays. Tweaked minimap object record for ladders
to account for the strange half-ladders that crop up on
occasion. Removed the function 'ObjDTM_Generate' and removed
the function 'ObjDTM_PathRecorder' these two have been
rendered obsolete with the new generation tool shipped with
the include. 'FindObjDTM' and 'ObjDTMWalk' will be removed
in the next version. If they are being used in your scripts
please update to use 'ObjDTM_Find' and 'ObjDTM_Walk' instead.
-Version 9.8: Added 'Delete ODTM' button to tool, adding ability to
delete and clear the current Object DTM.
-Version 9.7: Fixed form bugs in generation tool.
-Version 9.6: The generation tool is now part of the 'ODTM' menu, for
ease of access.
-Version 9.5: Added NPC dots to list of useable minimap objects (MM_NPC).
Please note that only stationary NPC's, like bankers, should
be used. Created a new generation tool. Super exciting.
Please see:
'Simba/Includes/ObjectDTM/Object DTM Generation Tool.simba'
So far, only the 'Single' tab, and the 'Path' tab are
functional. These two will allow you to make single Object
DTMs, and paths.
-Version 9.4: Fancy hackish stuff implemented to switch people over to
new extension without having to manually download.
-Version 9.3: Stopped scripters from crashing script when trying
to use area-related methods with an Object DTM with
no area information. Fixed the Minimap Object Record for
Cactus (MM_CACTUS). The include should now be useable
in the desert.
Phased out 'InObjDTMArea', use 'ObjDTM_InArea'
Phased out 'GenerateObjDTM', use 'ObjDTM_Generate'
Would like to:
Phased out 'LoadObjects' and 'SetupODTMI', use 'ObjDTM_Setup'
Phased out 'ObjDTMWalk', use 'ObjDTM_Walk'
Phased out 'FindObjDTM', use 'ObjDTM_Find'
-Version 9.2: Added extension updater! Hooray!
-Version 9.1: Removed SRL4 support since SRL5 is now standard.
New on-SMART guide for generation tool.
Fixed duplicate identifier errors.
-Version 8.9: Fixed a bug that caused 'ObjDTM_Walk' to be more
unreliable than it would otherwise be. Commenting out
Multi Object DTM related code until I can properly fix it.
-Version 8.8: Added the ability to delete sub-points while using
the 'ObjDTM_Generate' function. Added 'ObjDTM_PathRecorder',
which allows you to easily create paths.
-Version 8.7: Bug fix to 'ObjDTMToString', bug caused the area to be
nulled. Added the 'ObjDTM_Generate' function. This is a new
interactive Object DTM generation tool. You need SRL5 to use it.
-Version 8.6: Support for SRL5 added.
-Version 8.5: More small bug fixes/speed improvements, the function additions
in Version 8 still aren't really functional. Sorry :/. Added
'ObjDTM_InAreaEx' Which allows you to specify a specific point to
check to see if it is in the Object DTM's area. There is now
paint debugging, useable by setting the variable
'ObjDTM_Debug' to true in the setup of your script.
Trying to standardize the names of everything. Not there yet.
-Version 8: bug fix in finding function. Overall speed improvements. Added
'Multi-Object DTMs' which allow for multiple Object DTMs to be
defined in a string array, to use in the same way as single
Object DTMs, but if one fails, the code will try the next. Path-
walking function. All of these additions are untested. Will
try to get testing done soon. So this update is mostly for
the bug fix/speed improvement. But feel free to try the new stuff.
Haven't added comments, code is messy, real sorry about all of
this. Will be resolved in Rev 8.1.
Added:
ObjDTM_MultiWalk;
ObjDTM_InMultiArea;
ObjDTM_PathWalk;
ObjDTM_InAreaEx;
-Version 7.8: Changed the single use of SplitTPAEx to SplitTPAExWrap, as
I heard that it can cause memory leaks?
-Version 7.7: Changed a few things with how updates work. Now has the
ability to force a roll-back in case I broke something.
-Version 7.4/5/6: Changing naming convention for ease-of-updating purposes.
--------------------------------------------------------------------------------
-Rev7c: Updated minimap object record for boulders (MM_BOULDER), it never
got updated with the rest of the records in Rev 5. Fixed a small
issue with the minimap object record for ladders (MM_LADDER), causing
ladder finding to fail on rare occasions. Realized that main-point
tracking in the walking function was never implemented- now actually
functional.
-Rev7b: Fixed a bug in the 'ObjDTMToString' and 'ObjDTMFromString' functions
that resulted in an out-of-range error.
-Rev7a: Added maple trees, and rocks to list of useable minimap objects
(MM_MAPLE), (MM_ROCK).
-Rev 7: Added cacti to list of useable minimap objects (MM_CACTUS).
Fixed a rather grievous oversight on my part, and made sure that
SMART related code isn't actually compiled if SMART isn't defined
in the script. Added the rather verbosely-named
'PrintObjDTMRecFromString' This allows you to pass an Object DTM
in string-form, and have the record form print out in the debug.
This makes it easy to change the contents of string-form Object DTMs
during the writing of your scripts.
-Rev 6: Added the henge object (stone circle columns) to list of useable
minimap objects (MM_HENGE). Implemented polygonal areas.
Convex/Concave polygons can now be defined for Object DTM areas,
allowing for very specific area boundaries.
-Rev 5: I think color-finding has been improved in this revision, meaning
from now on the finding of objects is less likely to break.
-Rev4a: Improved accuracy of 'PointInPolygon' base code for polygon areas
added. Updated minimap object record for ladder.
-Rev 4: Added the function 'PointInPolygon' which now allows for accurate
implementation of the 'InObjDTMArea' function.
-Rev 3: Added the functions 'ObjDTMFromString' and 'ObjDTMToString' these
supplement the new, more compact string-form of Object DTMs. Updated
minimap object records for trees, ladders, and plants.
-Rev 2: Fixed minimap object record for dead trees. Added first version of
the Object DTM generator.
-Rev 1: Basic functionality to assist in the creation of Object DTMs, can find
Object DTMs at any angle, and includes a simple walking function, and
location check.
-Notes: Since the graphical update, the colors have been having a few
issues. Because of some bugs in PascalScript, the InObjDTMArea
function does not work; my apologies. On another note, if you attempt
to find an Object DTM, and it exists on screen, it will find it every
other time. Again, on account of some issues with PascalScript. If
you use this, there will also be a memory leak. Again: PascalScript.
-------------------------------------------------------------------------------}
type
MMObj = record
Center: TPoint;
ObjType: Integer;
end;
ObjDTMSP = record
Base: Integer;
Drift: Integer;
Point: TPoint;
end;
ObjDTM = record
MainPoint: TPoint;
NumOfPoints: Integer;
SubPoints: Array of ObjDTMSP;
NumOfAreaPoints: Integer;
Area: TPointArray;
end;
MMObjRec = record
Base: String; Color: Integer; CTS: Integer; Tol: Integer;
SplitSizeX, SplitSizeY: Integer;
SatMod, HueMod: Extended;
AvgNumOfPoints, AvgTol: Integer;
end;
TLine = record
A, B: TPoint;
end;
T2DStringArray = Array of TStringArray;
MMObjArray = Array of MMObj;
const
MM_LADDER = 0;
MM_TREE = 1;
MM_DEADTREE = 2;
MM_PLANT = 3;
MM_FLAX = 4;
MM_BOULDER = 5;
MM_HENGE = 6;
MM_CACTUS = 7;
MM_MAPLE = 8;
MM_ROCK = 9;
MM_NPC = 10;
var
MMObjRecords: Array of MMObjRec;
ObjDTM_Debug: Boolean;
procedure LoadObjects;
(*******************************************************************************
procedure LoadObjects;
By: euphemism
Last Edit: 13 Dec 2011 -- euphemism
Description: Loads the records for all valid objects to use with the include.
*******************************************************************************)
var
Ladder, Tree, DeadTree, Plant, Flax, Boulder, Henge, Cactus, Maple,
Rock, NPC: MMObjRec;
begin
with Ladder do
begin
Color := 602202; CTS := 1; Tol := 7;
SplitSizeX := 2; SplitSizeY := 2;
AvgNumOfPoints := 32; AvgTol := 14;
end;
with Tree do
begin
Color := 1133343; CTS := 1; Tol := 19;
SplitSizeX := 1; SplitSizeY := 1;
AvgNumOfPoints := 18; AvgTol := 12;
end;
with DeadTree do
begin
Color := 797238; CTS := 1; Tol := 7;
SplitSizeX := 2; SplitSizeY := 2;
AvgNumOfPoints := 13 AvgTol := 4;
end;
with Plant do
begin
Color := 3633484; CTS := 1; Tol := 7;
SplitSizeX := 1; SplitSizeY := 1;
AvgNumOfPoints := 22 AvgTol := 10;
end;
with Flax do
begin
Color := 11560292; CTS := 2; Tol := 0;
SplitSizeX := 2; SplitSizeY := 2;
HueMod := 1.01; SatMod := 2.87;
AvgNumOfPoints := 6; AvgTol := 3;
end;
with Boulder do
begin
Color := 5855833; CTS := 1; Tol := 7;
SplitSizeX := 1; SplitSizeY := 1;
AvgNumOfPoints := 25; AvgTol := 7;
end;
with Henge do
begin
Color := 4473666; CTS := 1; Tol := 6;
SplitSizeX := 1; SplitSizeY := 1;
AvgNumOfPoints := 9; AvgTol := 6;
end;
with Cactus do
begin
Color := 3633228; CTS := 1; Tol := 6;
SplitSizeX := 1; SplitSizeY := 1;
AvgNumOfPoints := 100; AvgTol := 80;
end;
with Maple do
begin
Color := 1130602; CTS := 1; Tol := 7;
SplitSizeX := 1; SplitSizeY := 1;
AvgNumOfPoints := 17; AvgTol := 5;
end;
with Rock do
begin
Color := 2969473; CTS := 1; Tol := 14;
SplitSizeX := 1; SplitSizeY := 1;
AvgNumOfPoints := 25; AvgTol := 12;
end;
with NPC do
begin
Color := 648667; CTS := 0; Tol := 34;
SplitSizeX := 1; SplitSizeY := 1;
AvgNumOfPoints := 9; AvgTol := 5;
end;
MMObjRecords := [Ladder, Tree, DeadTree, Plant, Flax, Boulder, Henge, Cactus,
Maple, Rock, NPC];
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
procedure ObjDTM_Setup;
(*******************************************************************************
procedure ObjDTM_Setup;
By: euphemism
Last Edit: 12 Jan 2012 -- euphemism
Description: Calls 'LoadObjects' to load the records for all valid objects
to use with the include. This procedure needs to be called at
the setup of the script.
*******************************************************************************)
begin
LoadObjects;
WriteLn('Object DTM Include: Setup complete.');
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function LinesIntersect(const Line1, Line2: TLine):Boolean;
(*******************************************************************************
function LinesIntersect(const Line1, Line2: TLine):Boolean;
By: euphemism
Last Edit: 12 Jan 2012 -- euphemism
Description: Checks to see if the two given line segments, 'Line1' and 'Line2'
intersect.
*******************************************************************************)
var
Ax, Ay, Bx, By, Cx, Cy, D, E, F, LX, LY, UX, UY : Extended;
begin
Result := false;
Ax := Line1.B.x - Line1.A.x;
Bx := Line2.A.x - Line2.B.x;
if (Ax < 0) then
begin
LX := Line1.B.x;
UX := Line1.A.x;
end
else
begin
UX := Line1.B.x;
LX := Line1.A.x;
end;
if (Bx > 0) then
begin
if (UX < Line2.B.x) or (Line2.A.x < LX) then
Exit;
end else
if (UX < Line2.A.x) or (Line2.B.x < LX) then
Exit;
Ay := Line1.B.y - Line1.A.y;
By := Line2.A.y - Line2.B.y;
if (Ay < 0) then
begin
LY := Line1.B.y;
UY := Line1.A.y;
end else
begin
UY := Line1.B.y;
LY := Line1.A.y;
end;
if (By > 0) then
begin
if (UY < Line2.B.y) or (Line2.A.y < LY) then
Exit;
end else
if (UY < Line2.A.y) or (Line2.B.y < LY) then
Exit;
Cx := Line1.A.x - Line2.A.x;
Cy := Line1.A.y - Line2.A.y;
D := (By * Cx) - (Bx * Cy);
F := (Ay * Bx) - (Ax * By);
if (F > 0) then
begin
if (D < 0) or (D > F) then
Exit;
end else
if (D > 0) or (D < F) then
Exit;
E := (Ax * Cy) - (Ay * Cx);
if (F > 0) then
begin
if (E < 0) or (E > F) then
Exit;
end else
if(E > 0) or (E < F) then
Exit;
Result := true;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
procedure ObjDTM_ClearCanvasArea(w, h: integer; Position: TPoint);
(*******************************************************************************
procedure ObjDTM_ClearCanvasArea(w, h: integer; Position: TPoint);
By: euphemism
Last Edit: 1 Dec 2011 -- euphemism
Description: Draws a clear bitmap with width 'w' and height 'h' at the
position 'Position'.
*******************************************************************************)
{$IFDEF SMART}
var
CleanBMP: integer;
Canvas: TCanvas;
begin
CleanBMP := BitmapFromString(w, h, '');
Canvas := TCANVAS.Create;
Canvas.Handle := SmartGetDebugDC;
DrawBitmap(CleanBMP, Canvas, Position.x , Position.y);
try
FreeBitmap(CleanBMP);
except
writeln('Unable to free SMART bitmap.');
end;
{$ELSE}
begin
{$ENDIF}
end;
{*******************************************************************************
procedure ObjDTM_DrawTextEx(Clear: Boolean; x, y: Integer; font, Text: string; Color: TColor);
Contributors: Jukka, Shuttleu
Description: Draws text onto the SMART Debug canvas at position x, y
*******************************************************************************}
procedure ObjDTM_DrawTextEx(Clear: Boolean; x, y: Integer; font, Text: string; Color:TColor);
{$IFDEF SMART}
var
i, height: integer;
tpa: tpointarray;
begin
tpa := LoadTextTPA(text,font,height);
for i:= 0 to high(tpa) do
begin
tpa[i].x := tpa[i].x + x;
tpa[i].y := tpa[i].y + y;
end;
SMART_DrawDotsEx(Clear, tpa, Color);
{$ELSE}
begin
{$ENDIF}
end;
function PointInPolygon(X, Y: Integer; Polygon: TPointArray): Boolean;
(*******************************************************************************
function PointInPolygon(X, Y: Integer; Polygon: TPointArray): Boolean;
By: euphemism
Last Edit: 1 Dec 2011 -- euphemism
Description: Checks to see if the given point, defined by 'X', and 'Y', lies
within the given concave/convex polygon, 'Polygon'. Each
consecutive vertex must be adjacent to the previous one.
*******************************************************************************)
var
I, Len, MaxX, MinX, MaxY, MinY: Integer;
Crossed0, Crossed1, Crossed2: Extended;
TestRay0, TestRay1, TestRay2: TLine;
Sides: Array of TLine;
begin
Crossed0 := 0;
Crossed1 := 0;
Crossed2 := 0;
Result := False;
Len := Length(Polygon);
SetLength(Sides, Len);
MaxX := Polygon[1].x;
MinX := Polygon[0].x;
MaxY := Polygon[1].y;
MinY := Polygon[0].y;
for I := 0 to (Len - 2) do //This loop creates an array of the sides of the polygon.
begin
Sides[i].A := Polygon[i];
Sides[i].B := Polygon[i + 1];
end;
Sides[Len - 1].A := Polygon[Len - 1]; //These two lines set the last side of the polygon.
Sides[Len - 1].B := Polygon[0];
for I := 0 to (Len - 1) do //This loop finds the minimum X and Y values from the
begin //passed vertices. This is so we know where to shoot our test ray.
MaxX := Max(Polygon[i].x, MaxX);
MinX := Min(Polygon[i].x, MinX);
MaxY := Max(Polygon[i].y, MaxY);
MinY := Min(Polygon[i].y, MinY);
end;
TestRay0.A := IntToPoint(X, Y); //This sets the test rays to useable segments.
TestRay0.B := IntToPoint(MinX - 10, MinY - 10);
TestRay1.A := IntToPoint(X, Y);
TestRay1.B := IntToPoint(MaxX + 10, MinY - 10);
TestRay2.A := IntToPoint(X, Y);
TestRay2.B := IntToPoint(MaxX + 10, MaxY + 10);
{$IFDEF SMART}
if ObjDTM_Debug then
begin
SMART_DrawPolygons(False, [Polygon], clWhite);
SMART_DrawLine(False, TestRay0.A, TestRay0.B, clRed);
SMART_DrawLine(False, TestRay1.A, TestRay1.B, clRed);
SMART_DrawLine(False, TestRay2.A, TestRay2.B, clRed);
end;
{$ENDIF}
for I := 0 to (Len - 1) do //This loop runs through all sides of the polygon and sees if the
begin //test rays intersect each side. If so, then we increase the 'CrossedX' values
//Using multiple test rays ensures accuracy.
if LinesIntersect(TestRay0, Sides[i]) then
Crossed0 := Crossed0 + 1;
if LinesIntersect(TestRay1, Sides[i]) then
Crossed1 := Crossed1 + 1;
if LinesIntersect(TestRay2, Sides[i]) then
Crossed2 := Crossed2 + 1;
end;
if Crossed1 <= Crossed0 then
Crossed0 := Crossed1;
if Crossed2 <= Crossed0 then //If the test rays crossed an odd number of sides, then the point is within
Crossed0 := Crossed2; //the polygon, if they crossed an even number of sides, or no sides, the point is outside.
Result := ((Crossed0 / 2) <> (Ceil(Crossed0 / 2))); //This line checks to see if the test rays crossed an even or odd
end; //number of sides, and sets the result accordingly.
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function MakeCircleTPA(NumOfPoints, cX, cY, Radius: Integer): TPointArray;
(*******************************************************************************
function MakeCircleTPA(NumOfPoints, cX, cY, Radius: Integer): TPointArray;
By: kanah
Last Edit: 22 Nov 2011 -- euphemism
Description: Creates a TPA with x number of points, where x is 'NumOfPoints'
around a center point specified by 'cX' and 'cY', with a
radius of 'Radius'.
*******************************************************************************)
var
I: Integer;
begin
SetLength(Result, NumOfPoints);
for I := 0 to (NumOfPoints - 1) do
begin
Result[I] := Point(Round(cX + Sin(2 * pi * I / NumOfPoints) * Radius),
Round(cY - Cos(2 * pi * I / NumOfPoints) * Radius));
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function GroundLevelCheck: Boolean;
(*******************************************************************************
function GroundLevelCheck: Boolean;
By: euphemism
Last Edit: 22 Nov 2011 -- euphemism
Description: Creates a circular slice out of the minimap, and checks to see
if the dominant color is black.
*******************************************************************************)
var
Half, I, TempColor, TPALength, Valid: Integer;
Lum, Hue, Sat: Extended;
TPA: TPointArray;
begin
TPA := MakeCircleTPA(500, MMCX, MMCY, 73);
TPALength := Length(TPA) - 1;
Half := Floor(TPALength / 2);
for I := 0 to TPALength do
begin
TempColor := GetColor(TPA[I].X, TPA[I].Y)
ColorToHSL(TempColor, Hue, Sat, Lum);
if Lum < 5 then
Inc(Valid);
end;
Result := (Valid < Half);
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function FindMiniMapObjEx(WhatObject: MMObjRec; x1, y1, x2, y2: Integer;
cX, cY, Radius: Integer): TPointArray;
(*******************************************************************************
function FindMiniMapObjEx(WhatObject: MMObjRec; x1, y1, x2, y2: Integer;
cX, cY, Radius: Integer): TPointArray;
By: euphemism
Last Edit: 17 Dec 2011 -- euphemism
Description: Finds all instances of the specified object, 'WhatObject'
within the specified box, within the specified circle,
and returns a TPA of the centers.
*******************************************************************************)
var
CTS, GoodAvg, H, I, Len, Match, Tolerance: Integer;
Added: Boolean;
CoordinatesTPA, CoordinatesTempTPA, TempTPA: TPointArray;
CoordinatesATPA, CoordinatesTempATPA: T2DPointArray;
TempTp: TPoint;
begin
CTS := GetColorToleranceSpeed;
SetColorToleranceSpeed(WhatObject.CTS);
if WhatObject.CTS > 1 then
SetColorSpeed2Modifiers(WhatObject.HueMod, WhatObject.SatMod);
Tolerance := WhatObject.Tol;
SetLength(CoordinatesTPA, 1);
SetLength(TempTPA, 1);
while Tolerance < 255 do
begin
if FindColorsTolerance(CoordinatesTempTPA, WhatObject.Color, x1, y1, //Finds the main color of the specified minimap object.
x2, y2, Tolerance) then
Break;
IncEx(Tolerance, 5);
end;
for H := 0 to High(CoordinatesTempTPA) do //Makes sure the colors are actually in the specified circle.
begin
TempTPA[0] := CoordinatesTempTPA[H];
if InCircle(TempTPA[0].x, TempTPA[0].y, cX, cY, Radius) then
begin
CoordinatesTPA[Match] := TempTPA[0];
SetLength(CoordinatesTPA, Length(CoordinatesTPA) + 1);
Inc(Match);
end;
end;
if WhatObject.CTS > 1 then
SetColorSpeed2Modifiers(0.2, 0.2); //Sets color speed modifiers to defaults.
SetColorToleranceSpeed(CTS); //Sets color speed to what it was before the function was called.
//---------------------------------------------------------------------------//
if Length(CoordinatesTPA) = 0 then //If no colors are found, then the function exits.
Exit;
SplitTPAExWrap(CoordinatesTPA, WhatObject.SplitSizeX, WhatObject.SplitSizeY, //Uses SplitTPA based on the MMObjRec's specified sizes in order to group the
CoordinatesTempATPA); //found points into potential objects.
SetLength(CoordinatesATPA, Length(CoordinatesTempATPA));
for I := 0 to High(CoordinatesTempATPA) do //Runs through all the groups to perform the crude algorithm to
begin //determine if we have found an object.
Match := 0;
Added := False;
TempTP := MiddleTPA(CoordinatesTempATPA[I]); //Gets the middle of the current group.
if InRange(Length(CoordinatesTempATPA[i]), //Checks to see if the number of points in the current group falls
WhatObject.AvgNumOfPoints - WhatObject.AvgTol, //within the MMObjRec's specified ranges.
WhatObject.AvgNumOfPoints + WhatObject.AvgTol) then
begin
CoordinatesATPA[I] := CoordinatesTempATPA[I];
Added := True;
Inc(GoodAvg);
end else //If the group didn't pass the first check, then we will try to
begin //determine if it is the object another way.
if (((Distance(cX, cY, TempTP.X, TempTP.Y) < (Radius + 3)) //If the objects is near the edge of the minimap, then we assume
and (Distance(cX, cY, TempTP.X, TempTP.Y) > (Radius - 2))) //that not all of the object will be visible.
and not Added) then
begin
if (InRange(Length(CoordinatesTempATPA[i]), //So, we lower the amount of points needed to make a match, based
((WhatObject.AvgNumOfPoints / 2) - ((WhatObject.AvgTol / 3) * 2)), //on the original values in the MMObjRec.
((WhatObject.AvgNumOfPoints / 2) + ((WhatObject.AvgTol / 3) * 2)))) then
begin
CoordinatesATPA[i] := CoordinatesTempATPA[i];
Inc(GoodAvg);
end;
end;
end;
end;
SortATPASize(CoordinatesATPA, True);
SetLength(CoordinatesATPA, GoodAvg); //Truncates all groups that didn't pass off the array.
Len := Length(CoordinatesATPA);
SetLength(Result, Len);
for I := 0 to (Len - 1) do //Loops through the remaining groups, and adds their centers to the
Result[i] := MiddleTPA(CoordinatesATPA[i]); //result TPA.
Match := 0;
for I := 0 to (Len - 2) do //This counters an odd bug where the same object can result as two very close objects.
begin
if (not (Distance(Result[i].x, Result[i].y, Result[i + 1].x, Result[i + 1].y) < 5)) then
Continue;
Inc(Match);
Result[i] := MiddleTPA([Result[i], Result[i + 1]]);
Result[i + 1] := Result[Len - 1];
end;
SetLength(Result, Len - Match);
(* Comment the line below to paint boxes over objects as they are found. *)//This bit of code will draw boxes around the centers of all found objects.
(*-------------------------------------------------------------------------------
{$IFDEF SMART}
SMART_DrawBoxEx(True, IntToBox(0, 0, 1, 1), clGreen);
{$ENDIF}
for I := 0 to High(TPA) do
begin
{$IFDEF SMART}
SMART_DrawBoxEx(False, IntToBox(TPA[i].x - 3, TPA[i].y - 3, TPA[i].x + 3,
TPA[i].y + 3), clBlue);
{$ENDIF}
end;
//----------------------------------------------------------------------------*)
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function FindMiniMapObj(WhatObject: MMObjRec): TPointArray;
(*******************************************************************************
function FindMiniMapObj(WhatObject: MMObjRec): TPointArray;
By: euphemism
Last Edit: 1 Jan 2012 -- euphemism
Description: Finds all instances of the specified object, 'WhatObject'
on the minimap, and returns a TPA of the centers.
*******************************************************************************)
begin
Result := FindMiniMapObjEx(WhatObject, MMX1, MMY1, MMX2, MMY2, MMCX, MMCY, 75);
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTMFromString(ObjDTMString: String): ObjDTM;
(*******************************************************************************
function ObjDTMFromString(ObjDTMString: String): ObjDTM;
By: euphemism
Last Edit: 6 Dec 2011 -- euphemism
Description: Converts a string into an Object DTM record.
*******************************************************************************)
var
AB, I, Len, SP: Integer;
ExIntArray: TIntegerArray;
ExStrArray: TStringArray;
begin
ExStrArray := Explode(':', ObjDTMString); //Explodes the string into an array based on the delimiter ':'
Len := Length(ExStrArray);
SetLength(ExIntArray, Len);
for I := 0 to (Len - 1) do
ExIntArray[i] := StrToInt(ExStrArray[i]); //Converts the string array into an integer array.
Result.MainPoint.x := ExIntArray[0]; //Sets the x and y of the main-point.
Result.MainPoint.y := ExIntArray[1];
Result.NumOfPoints := ExIntArray[2]; //Sets the number of points in the Object DTM.
SetLength(Result.SubPoints, Result.NumOfPoints);
for I := 1 to Result.NumOfPoints do //Loops through and sets the sub-points' values for
begin //base type, drift, and point location.
SP := ((i * 3) + (i - 1));
Result.SubPoints[i - 1].Base := ExIntArray[SP];
Result.SubPoints[i - 1].Drift := ExIntArray[SP + 1];
Result.SubPoints[i - 1].Point.x := ExIntArray[SP + 2];
Result.SubPoints[i - 1].Point.y := ExIntArray[SP + 3];
end;
if ((Len > (SP + 4)) and (ExIntArray[SP + 4] > 0)) then //loops through and sets the area box corners.
begin
Result.NumOfAreaPoints := ExIntArray[SP + 4];
SetLength(Result.Area, Result.NumOfAreaPoints);
AB := SP + 4;
Len := ExIntArray[SP + 4];
for I := 1 to Len do
begin
IncEx(AB, 2);
Result.Area[i - 1].x := ExIntArray[AB - 1];
Result.Area[i - 1].y := ExIntArray[AB];
end;
end else
begin
Result.NumOfAreaPoints := 0;
SetLength(Result.Area, 0);
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTMToString(ObjectDTM: ObjDTM): String;
(*******************************************************************************
function ObjDTMToString(ObjectDTM: ObjDTM): String;
By: euphemism
Last Edit: 3 Jan 2012 -- euphemism
Description: Converts an Object DTM record into a string.
*******************************************************************************)
var
I, Len: Integer;
begin
SetLength(Result, 0);
Result := IntToStr(ObjectDTM.MainPoint.x) + ':';
Result := Result + IntToStr(ObjectDTM.MainPoint.y) + ':';
Result := Result + IntToStr(ObjectDTM.NumOfPoints);
for I := 0 to (ObjectDTM.NumOfPoints - 1) do //Loops through and just adds all the values into
begin //a single string with the delimiter ':' between values.
Result := Result + ':' + IntToStr(ObjectDTM.SubPoints[i].Base);
Result := Result + ':' + IntToStr(ObjectDTM.SubPoints[i].Drift);
Result := Result + ':' + IntToStr(ObjectDTM.SubPoints[i].Point.x);
Result := Result + ':' + IntToStr(ObjectDTM.SubPoints[i].Point.y);
end;
if (ObjectDTM.NumOfAreaPoints > 0) then //Checks to see if an area box is defined, and if so,
begin //adds it to the end of the string.
Result := Result + ':' + IntToStr(ObjectDTM.NumOfAreaPoints);
Len := ObjectDTM.NumOfAreaPoints;
for I := 0 to (Len - 1) do
begin
if Len = 0 then
Break;
Result := Result + ':' + IntToStr(ObjectDTM.Area[i].x);
Result := Result + ':' + IntToStr(ObjectDTM.Area[i].y);
end;
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ExtractBasesFromObjDTM(ObjectDTM: String): TIntegerArray;
(*******************************************************************************
function ExtractBasesFromObjDTM(ObjectDTM: String): TIntegerArray;
By: euphemism
Last Edit: 17 Dec 2011 -- euphemism
Description: Takes an Object DTM, and extracts unique sub-point bases.
i.e. if an Object DTM has three sub-points, two if which
are trees, and one is a ladder, the function's output
would be [1, 0]
*******************************************************************************)
var
H, I: Integer;
ObjDTMCopy: ObjDTM;
begin
H := 0;
SetLength(Result, 0);
ObjDTMCopy := ObjDTMFromString(ObjectDTM); //Takes the Object DTM in string-form, and converts it to
//an ObjDTM type.
for I := 0 to (ObjDTMCopy.NumOfPoints - 1) do //Loops through the sub-points
begin
if not InIntArray(Result, ObjDTMCopy.SubPoints[i].Base) then //If the sub-point base isn't already existant in the result,
begin //then we add it.
Inc(H);
SetLength(Result, H);
Result[H - 1] := ObjDTMCopy.SubPoints[i].Base;
end;
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ExtractBasesFromMultiObjDTM(ObjectDTM: TStringArray): TIntegerArray;
(*******************************************************************************
function ExtractBasesFromObjDTMs(ObjectDTM: TStringArray): TIntegerArray;
By: euphemism
Last Edit: 17 Dec 2011 -- euphemism
Description: Takes a list of Object DTMs, and extracts unique
sub-point bases. i.e. if out of all the Object DTMs,
four sub-points have trees as bases, one is a ladder,
and another is a plant, the function's output
would be [1, 0, 3]
*******************************************************************************)
var
H, I, Len, Z: Integer;
BasesArray: TIntegerArray;
begin
SetLength(Result, 0);
Z := 0;
Len := Length(ObjectDTM);
for I := 0 to (Len - 1) do //Loops through each Object DTM within the Multi
begin //Object DTM
BasesArray := ExtractBasesFromObjDTM(ObjectDTM[i]); //Extracts bases from the Object DTM being looped through
for H := 0 to High(BasesArray) do //Goes through each base to see if it has been added to
if not InIntArray(Result, BasesArray[H]) then //the result, if not, then it is added.
begin
Inc(Z);
SetLength(Result, Z);
Result[Z - 1] := BasesArray[H];
end;
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ExtractBasesFromMultiPath(Path: T2DStringArray): TIntegerArray;
(*******************************************************************************
function ExtractBasesFromPath(Path: T2DStringArray): TIntegerArray;
By: euphemism
Last Edit: 17 Dec 2011 -- euphemism
Description: Takes a given path, and extracts unique sub-point bases
from the Object DTMs within. i.e. if out of all of the
Object DTMs, four sub-points have trees as bases, one is
a ladder, and another is a plant, the function's output
would be [1, 0, 3]
*******************************************************************************)
var
H, I, Z: Integer;
BasesArray: TIntegerArray;
begin
SetLength(Result, 0);
for I := 0 to High(Path) do //Loops through each Multi Object DTM within
begin //the path
BasesArray := ExtractBasesFromMultiObjDTM(Path[i]); //Extracts the bases from the Multi Object DTM.
for H := 0 to High(BasesArray) do //Loops through the extracted bases.
begin
if not InIntArray(Result, BasesArray[h]) then //If the base isn't in the result, then it is added.
begin
Inc(Z);
SetLength(Result, Z);
Result[Z - 1] := BasesArray[h];
end;
end;
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function GatherMiniMapObjects(ObjectsToFind: TIntegerArray): MMObjArray;
(*******************************************************************************
function GatherMiniMapObjects(ObjectsToFind: TIntegerArray): MMObjArray;
By: euphemism
Last Edit: 17 Dec 2011 -- euphemism
Description: Takes a list of minimap objects, and locates them on the
minimap. The result is an array of the coordinate locations
and types of the objects.
*******************************************************************************)
var
H, I, J, NewRangeEnd, NewRangeStart, NumOfBase: Integer;
BaseTPA: TPointArray;
begin
SetLength(Result, 0);
Freeze;
for I := 0 to High(ObjectsToFind) do //This loop runs through all the objects in the array,
begin //finds them, and adds them to a new array that keeps track
//of where each object is, and what type of object it is.
BaseTPA := FindMiniMapObj(MMObjRecords[ObjectsToFind[i]]);
NumOfBase := Length(BaseTPA);
NewRangeStart := Length(Result);
NewRangeEnd := Length(Result) + NumOfBase;
SetLength(Result, NewRangeEnd);
for J := 0 to (NumOfBase - 1) do
begin
Result[J + NewRangeStart].Center := BaseTPA[J];
end;
for H := NewRangeStart to (NewRangeEnd - 1) do
begin
Result[H].ObjType := ObjectsToFind[i];
end;
end;
UnFreeze;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTM_FindEx(DTMToFind: String; out cx, cy: Integer;
GroundLevel: Boolean; BaseObjects: MMObjArray): Boolean;
(*******************************************************************************
function ObjDTM_FindEx(DTMToFind: String; out cx, cy: Integer;
GroundLevel: Boolean; BaseObjects: MMObjArray): Boolean;
By: euphemism
Last Edit: 26 Dec 2011 -- euphemism
Description: Finds the specified Object DTM, 'DTMToFind' on the minimap.
Results true if found, and the main point is passed via
reference through 'cx, and 'cy'.
*******************************************************************************)
var
BaseHigh, DeltaX, DeltaY, H, I, J, K, Match, NumOfSP: Integer;
ScreenRotationR: Extended;
Found: Boolean;
TempCenter, TempCenter2, TempCenter3, ResultPoint: TPoint;
DebugPoints: TIntegerArray;
ObjDTMCopy: ObjDTM;
BaseTPA, DebugTPA, ResultsTPA: TPointArray;
begin
Found := False;
Result := Found;
if not GroundLevel = GroundLevelCheck then //Checks to see if the player is currently at ground level,
Exit;
cx := 0;
cy := 0;
Match := 0;
ObjDTMCopy := ObjDTMFromString(DTMToFind);
NumOfSP := ObjDTMCopy.NumOfPoints - 1;
if ObjDTM_Debug then
begin
SetLength(DebugTPA, ObjDTMCopy.NumOfPoints);
SetLength(DebugPoints, ObjDTMCopy.NumOfPoints);
end;
for H := 0 to NumOfSP do //This makes the sub-points relative to the main-point.
begin
ObjDTMCopy.SubPoints[H].Point.x := ObjDTMCopy.MainPoint.x - ObjDTMCopy.SubPoints[H].Point.x;
ObjDTMCopy.SubPoints[H].Point.y := ObjDTMCopy.MainPoint.y - ObjDTMCopy.SubPoints[H].Point.y;
end;
BaseHigh := Length(BaseObjects) - 1;
SetLength(ResultsTPA, NumOfSP + 1);
SetLength(BaseTPA, BaseHigh + 1);
ScreenRotationR := rs_GetCompassAngleRadians; //Gets the Runescape compass's direction.
for I := 0 to BaseHigh do //This line rotates the found points based on the compass direction.
BaseObjects[i].Center := RotatePoint(BaseObjects[i].Center, ScreenRotationR, MMCX, MMCY);
for H := 0 to NumOfSP do //This large nest of loops is what finds the Object DTM.
begin //The first loop runs through all the sub-points.
if Found then
Break;
for I := 0 to BaseHigh do //This second loop runs through all the found objects.
begin
Match := 0;
if not (BaseObjects[i].ObjType = ObjDTMCopy.SubPoints[H].Base) then //If the current object the code is looking at doesn't match the
Continue; //sub-point we are looping through, then we continue through the loop.
TempCenter := BaseObjects[i].Center; //This group of lines creates a temporary main-point based off this
TempCenter.x := TempCenter.x + ObjDTMCopy.SubPoints[H].Point.x; //object's position that should be very near to the actual main-point if this is in fact the correct
TempCenter.y := TempCenter.y + ObjDTMCopy.SubPoints[H].Point.y; //object at the correct position.
for J := 0 to NumOfSP do //This loop runs through all the sub-points, to see if they exist where they should
begin //from the new, temporary main-point created off of the object we are looping through.
DeltaX := TempCenter.x - ObjDTMCopy.SubPoints[J].Point.x; //These two lines move the sub-point we are looping through to its position relative to
DeltaY := TempCenter.y - ObjDTMCopy.SubPoints[J].Point.y; //the new, temporary main-point.
TempCenter2 := IntToPoint(DeltaX, DeltaY);
for K := 0 to BaseHigh do //This loops through all the found objects again.
begin
if (InCircle(BaseObjects[K].Center.x, BaseObjects[K].Center.y, //This if then statement checks to see if an object of the right type exists
TempCenter2.x, TempCenter2.y, ObjDTMCopy.SubPoints[J].Drift) //within a circle, specified by the drift in the Object DTM record, around the newly positioned
and (BaseObjects[K].ObjType = ObjDTMCopy.SubPoints[J].Base)) then //sub-point.
begin
DeltaX := BaseObjects[K].Center.x + ObjDTMCopy.SubPoints[J].Point.x;//If so, the loop adds the new, temporary main-point to an array, and
DeltaY := BaseObjects[K].Center.y + ObjDTMCopy.SubPoints[J].Point.y;//increases the match variable.
TempCenter3 := IntToPoint(DeltaX, DeltaY);
if Match > NumOfSP then
Break;
ResultsTPA[Match] := TempCenter3;
if ObjDTM_Debug then
begin
DebugTPA[Match] := RotatePoint(BaseObjects[K].Center, (ScreenRotationR * -1), MMCX, MMCY);
DebugPoints[Match] := ObjDTMCopy.SubPoints[J].Drift;
end;
Inc(Match);
end;
end;
end;
if Match = ObjDTMCopy.NumOfPoints then //If, after looping through all the objects from the new, temporary main-point
begin //we just created, and we have matched sub-points that equal the number of
//sub-points in the Object DTM, then we know we have a match.
Found := True;
ResultPoint := RotatePoint(MiddleTPA(ResultsTPA), //We get the middle of all the temporary main-points to ensure that the returned
(ScreenRotationR * -1), MMCX, MMCY); //point is as accurate as possible, and we rotate it back to the current compass
//direction.
cx := ResultPoint.x;
cy := ResultPoint.y;
{$IFDEF SMART}
if ObjDTM_Debug then
begin
SMART_DrawCircle(True, DebugTPA[0], DebugPoints[0], False, clWhite);
for I := 1 to NumOfSP do
SMART_DrawCircle(False, DebugTPA[i], DebugPoints[i], False, clWhite);
for I := 0 to NumOfSP do
SMART_DrawLine(False, ResultPoint, DebugTPA[i], clWhite);
end;
{$ENDIF}
end;
if Found then //This line just makes sure we don't do any un-necessary looping.
Break;
end;
end;
Result := Found;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTM_Find(DTMToFind: String; out cx, cy: Integer;
GroundLevel: Boolean): Boolean;
(*******************************************************************************
function ObjDTM_Find(DTMToFind: String; var cx, cy: Integer;
GroundLevel: Boolean): Boolean;
By: euphemism
Last Edit: 26 Dec 2011 -- euphemism
Description: Calls 'ObjDTM_FindEx'.
*******************************************************************************)
var
BasesToCheck: TIntegerArray;
BaseObjects: MMObjArray;
begin
Result := False;
if not GroundLevel = GroundLevelCheck then //Checks to see if the player is currently at ground level,
Exit; //it then sees if the result is equal to the 'GroundLevel' parameter.
//Otherwise, it exits.
BasesToCheck := ExtractBasesFromObjDTM(DTMToFind);
BaseObjects := GatherMiniMapObjects(BasesToCheck);
Result := ObjDTM_FindEx(DTMToFind, cx, cy, GroundLevel, BaseObjects);
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTM_FindMulti(MultiDTMToFind: TStringArray; out cx, cy: Integer;
GroundLevel: Boolean): Boolean;
(*******************************************************************************
function ObjDTM_FindMulti(MultiDTMToFind: TStringArray; out cx, cy: Integer;
GroundLevel: Boolean): Boolean;
By: euphemism
Last Edit: 19 Dec 2011 -- euphemism
Description: Loops through each Object DTM in the Multi Object DTM
and calls 'ObjDTM_FindEx'.
*******************************************************************************)
var
I: Integer;
BasesToCheck: TIntegerArray;
BaseObjects: MMObjArray;
begin
Result := False;
if not GroundLevel = GroundLevelCheck then //Checks to see if the player is currently at ground level,
Exit; //it then sees if the result is equal to the 'GroundLevel' parameter.
//Otherwise, it exits.
BasesToCheck := ExtractBasesFromMultiObjDTM(MultiDTMToFind);
BaseObjects := GatherMiniMapObjects(BasesToCheck);
for I := 0 to High(MultiDTMToFind) do
begin
Result := ObjDTM_FindEx(MultiDTMToFind[i], cx, cy, GroundLevel, BaseObjects);
if Result then
Break;
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTM_InAreaEx(DTMToCheck: String; cX, cY: Integer;
GroundLevel: Boolean; BaseObjects: MMObjArray): Boolean;
(*******************************************************************************
function InObjDTMArea(DTMToCheck: String; cX, cY: Integer;
GroundLevel: Boolean; BaseObjects: MMObjArray): Boolean;
By: euphemism
Last Edit: 12 Jan 2012 -- euphemism
Description: Calls 'ObjDTM_Find' to find the Object DTM 'DTMToCheck'. If
found, Uses the area of 'DTMToCheck' to see if the point
is within. Because the area is specified by a concave/convex
polygon, it can be tailored to fit a very specific area.
Returns true if the point is within the area.
*******************************************************************************)
var
I, X, Y: Integer;
ScreenRotationD: Extended;
Area: TPointArray;
ObjCopy: ObjDTM;
begin
Result := False;
ObjCopy := ObjDTMFromString(DTMToCheck);
if ObjCopy.NumOfAreaPoints = 0 then
begin
WriteLn('Object DTM Include: Warning, you are passing an Object DTM with' +
' no defined area to an area-related method. Exiting method.');
Exit;
end;
ScreenRotationD := rs_GetCompassAngleDegrees; //Gets the current compass direction in order to
//properly rotate the box.
if ObjDTM_FindEx(DTMToCheck, X, Y, GroundLevel, BaseObjects) then
begin
SetLength(Area, ObjCopy.NumOfAreaPoints);
for I := 0 to (ObjCopy.NumOfAreaPoints - 1) do //Makes the box corners relative to the found main-point,
begin //and rotates the box according to the compass direction.
ObjCopy.Area[i].x := ObjCopy.Area[i].x - ObjCopy.MainPoint.x;
ObjCopy.Area[i].y := ObjCopy.Area[i].y - ObjCopy.MainPoint.y;
ObjCopy.Area[i].x := X + ObjCopy.Area[i].x;
ObjCopy.Area[i].y := Y + ObjCopy.Area[i].y;
Area[i] := RotatePoint(ObjCopy.Area[i], Radians(ScreenRotationD) * -1,
X, Y);
end;
Result := PointInPolygon(cX, cY, Area); //Checks to see if the player is inside the area box.
end else //If so, the function results true.
begin
Result := False;
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTM_InArea(DTMToCheck: String; GroundLevel: Boolean): Boolean;
(*******************************************************************************
function ObjDTM_InArea(DTMToCheck: String; GroundLevel: Boolean): Boolean;
By: euphemism
Last Edit: 19 Dec 2011 -- euphemism
Description: Calls 'ObjDTM_InAreaEx', uses the area of 'DTMToCheck' to
see if the player is within the area. Because the area is
specified by a concave/convex polygon, it can be tailored to
fit a very specific area. Returns true if the player is
within the area.
*******************************************************************************)
var
BasesToCheck: TIntegerArray;
BaseObjects: MMObjArray;
begin
BasesToCheck := ExtractBasesFromObjDTM(DTMToCheck);
BaseObjects := GatherMiniMapObjects(BasesToCheck);
Result := ObjDTM_InAreaEx(DTMToCheck, MMCX, MMCY, GroundLevel, BaseObjects);
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTM_InMultiArea(MultiDTMToCheck: TStringArray; cX, cY: Integer;
GroundLevel: Boolean): Boolean;
(*******************************************************************************
function InMultiObjDTMArea(MultiDTMToCheck: TStringArray; cX, cY: Integer;
GroundLevel: Boolean): Boolean;
By: euphemism
Last Edit: 26 Nov 2011 -- euphemism
Description: Calls 'ObjDTM_InAreaEx' for each Object DTM within the
Multi Object DTM. If the given point is within the area
of one of the Object DTMs, this function breaks out of the loop
and results true.
*******************************************************************************)
var
H: Integer;
BasesToCheck: TIntegerArray;
BaseObjects: MMObjArray;
begin
BasesToCheck := ExtractBasesFromMultiObjDTM(MultiDTMToCheck);
BaseObjects := GatherMiniMapObjects(BasesToCheck);
Result := False;
for H := 0 to High(MultiDTMToCheck) do
begin
Result := ObjDTM_InAreaEx(MultiDTMToCheck[h], MMCX, MMCY, GroundLevel, BaseObjects);
if Result then
Break;
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTM_WalkEx(ObjDTMToWalk: String; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean): Boolean;
(*******************************************************************************
function ObjDTM_WalkEx(ObjDTMToWalk: String; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean): Boolean;
By: euphemism
Last Edit: 07 Dec 2011 -- euphemism
Description: Calls 'ObjDTM_FindEx' every x milliseconds specified by 'PollRate'
a maximum of x tries, specified by 'Tries' to find the
Object DTM 'ObjDTMToWalk'. If found, Waits for the flag to
be a distance x from the player, where x is 'FlagDistance'.
If the Object DTM is found, and the function has maxed out
the tries, but the main-point is off the minimap, the
function will click the closest available point. Returns true
if the Object DTM was found, and it clicked to walk.
*******************************************************************************)
var
Attempts, X, XOfQ, Y, YOfQ: Integer;
Theta: Extended;
Found, Tracking: Boolean;
TrackP: TPoint;
BasesToCheck: TIntegerArray;
BaseObjects: MMObjArray;
begin
Attempts := 0;
Found := False;
Result := False;
Tracking := False;
BasesToCheck := ExtractBasesFromObjDTM(ObjDTMToWalk);
while Attempts <= Tries do //If the function fails, it will loop through as many times as there are tries.
begin
Inc(Attempts);
BaseObjects := GatherMiniMapObjects(BasesToCheck);
if ObjDTM_FindEx(ObjDTMToWalk, X, Y, GroundLevel, BaseObjects) then
begin
Found := True;
if InCircle(X, Y, MMCX, MMCY, 75) then //This checks to see if the main-point is actually clickable.
begin
WriteLn('Found Object DTM, walking.');
Mouse(X, Y, 0, 0, True); //Clicks.
Wait(500);
FFlag(FlagDistance); //Waits until the specified distance is reached.
WriteLn('Flag distance reached.');
Result := True;
Break;
end else
begin //If the Object DTM is found, but the main-point is off-screen,
//then we make note of the current position, but don't click.
TrackP.x := X;
TrackP.y := Y;
if not Tracking then
begin
WriteLn('Found Object DTM, but can' + #39 + 't reach main point. ' +
'Tracking Object DTM.');
Tracking := True;
end;
if ((Attempts = Tries) and Found) then //If we have reached the maximum number of tries, and the Object DTM
begin //has been found, but still isn't clickable, then we find the closest
//available point and click it.
Theta := arctan2((abs(TrackP.y - MMCY)), (abs(TrackP.x - MMCX)));
if ((TrackP.y - MMCY) < 0) then
YOfQ := (((Floor(74 * sin(Theta))) * -1) + MMCY)
else
YOfQ := ((Floor(74 * sin(Theta))) + MMCY);
if ((TrackP.x - MMCX) < 0) then
XOfQ := (((Floor(74 * cos(Theta))) * -1) + MMCX)
else
XOfQ := ((Floor(74 * cos(Theta))) + MMCX);
Mouse(XOfQ, YOfQ, 0, 0, True);
Wait(500);
WriteLn('Found DTM, but couldn' + #39 +
't reach main point, getting as close as possible.');
FFlag(FlagDistance); //Waits until the specified distance is reached.
Result := True;
end;
end;
end else
begin
WriteLn('Did not find Object DTM.');
Found := False;
Result := False;
Wait(PollRate); //If the Object DTM isn't found, then we wait for the specified amount
end; //of time before trying to find it again.
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTM_Walk(ObjDTMToWalk: String; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean): Boolean;
(*******************************************************************************
function ObjDTM_Walk(ObjDTMToWalk: String; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean): Boolean;
By: euphemism
Last Edit: 19 Dec 2011 -- euphemism
Description: Calls 'ObjDTM_WalkEx'.
*******************************************************************************)
begin
Result := ObjDTM_WalkEx(ObjDTMToWalk, FlagDistance, PollRate, Tries, GroundLevel);
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
(*
function ObjDTM_MultiWalkEx(ObjDTMToWalk: TStringArray; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean; BaseObjects: MMObjArray): Boolean;
//******************************************************************************
function ObjDTM_MultiWalkEx(ObjDTMToWalk: TStringArray; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean; BaseObjects: MMObjArray): Boolean;
By: euphemism
Last Edit: 19 Dec 2011 -- euphemism
Description: Takes the given Multi Object DTM 'ObjDTMToWalk' and attempts to
find it 'Tries' amount of times. If not found, it will wait
'PollRate' milliseconds before trying again. If found, the
function will click the main-point of the found Object DTM, and
will wait until the player is within 'FlagDistance' before
resulting true. Otherwise, the function will result false.
//******************************************************************************
var
I, X, Y: Integer;
begin
Result := False;
for I := 0 to High(ObjDTMToWalk) do
begin
if ObjDTM_FindEx(ObjDTMToWalk[i], X, Y, GroundLevel, BaseObjects) then
begin
WriteLn('yeah');
Result := ObjDTM_WalkEx(ObjDTMToWalk[i], FlagDistance, PollRate, Tries, GroundLevel, BaseObjects);
Break;
end;
WriteLn('Did not find, trying next.');
end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTM_MultiWalk(ObjDTMToWalk: TStringArray; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean): Boolean;
//******************************************************************************
function ObjDTM_MultiWalk(ObjDTMToWalk: TStringArray; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean): Boolean;
By: euphemism
Last Edit: 19 Dec 2011 -- euphemism
Description: Calls 'ObjDTM_MultiWalkEx'
//******************************************************************************
var
BasesToCheck: TIntegerArray;
BaseObjects: MMObjArray;
begin
BasesToCheck := ExtractBasesFromMultiObjDTM(ObjDTMToWalk);
BaseObjects := GatherMiniMapObjects(BasesToCheck);
Result := ObjDTM_MultiWalkEx(ObjDTMToWalk, FlagDistance, PollRate, Tries, GroundLevel, BaseObjects);
end;
*)
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
(*
function ObjDTM_PathWalk(Path: T2DStringArray; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean): Boolean;
//******************************************************************************
function ObjDTM_PathWalk(Path: T2DStringArray; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean): Boolean;
By: euphemism
Last Edit: 19 Dec 2011 -- euphemism
Description: Allegedly walks an Object DTM path, which is a two-dimensional
string array comprised of Multi Object DTMs.
//******************************************************************************
var
H, I, Len, X, Y: Integer;
Found: Boolean;
BasesToCheck: TIntegerArray;
BaseObjects: MMObjArray;
begin
Found := False;
Result := True;
BasesToCheck := ExtractBasesFromPath(Path);
BaseObjects := GatherMiniMapObjects(BasesToCheck);
Len := Length(Path);
for H := (Len - 1) downto 0 do
begin
for I := 0 to High(Path[h]) do
begin
if (not ObjDTM_FindEx(Path[h][i], X, Y, GroundLevel, BaseObjects)) then
Continue;
Found := True;
Break;
end;
if Found then
Break;
end;
if (not Found) then
Exit;
Mouse(X, Y, 0, 0, True);
FFlag(FlagDistance);
for I := (H + 1) to (Len - 1) do
if (not ObjDTM_MultiWalkEx(Path[h], FlagDistance, PollRate, Tries, GroundLevel, BaseObjects)) then
Exit;
Result := True;
end;
*)
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function ObjDTM_WalkPath(Path: TStringArray; FlagDistance, PollRate,
Tries: Integer; CheckEndPoints, GroundLevel: Boolean): Boolean;
(*******************************************************************************
function ObjDTM_WalkPath(Path: TStringArray; FlagDistance, PollRate,
Tries: Integer; CheckEndPoints, GroundLevel: Boolean): Boolean;
By: euphemism
Last Edit: 07 Dec 2011 -- euphemism
Description: Walks the TStringArray 'Path'. For each node, it will look for
it every x milliseconds specified by 'PollRate'
a maximum of x tries, specified by 'Tries' to find the
current node. If found, clicks, and waits for the flag to
be a distance x from the player, where x is 'FlagDistance'.
If the Object DTM is found, and the function has maxed out
the tries, but the main-point is off the minimap, the
function will click the closest available point. If
'CheckEndPoints' is set to true, the function will check
to see if the player is within the area polygon of the first node
before walking the path. If not, will result false and exit.
If the function walks the entire path, it will check to see if
the player is within the area polygon of the last node. If not,
the function will return false. Returns true if the
entire path is walked.
*******************************************************************************)
var
Attempts, I, X, XOfQ, Y, YOfQ: Integer;
Theta: Extended;
Found, Reset, Tracking: Boolean;
TrackP: TPoint;
BasesToCheck: TIntegerArray;
BaseObjects: MMObjArray;
begin
Reset := False;
if CheckEndPoints then
begin
if (not ObjDTM_InArea(Path[0], GroundLevel)) then //If 'CheckEndPoints' is true, will check to see if player is within area
begin //polygon of first node. If not, will not walk the path.
WriteLn('Object DTM Include: Not at beginning of path. Exiting.');
Result := False;
Exit;
end;
end;
for I := 0 to High(Path) do //Loops through each node in the path, performing the below actions.
begin
Attempts := 0;
Found := False;
Result := False;
Tracking := False;
BasesToCheck := ExtractBasesFromObjDTM(Path[i]);
while Attempts <= Tries do //If the function fails, it will loop through as many times as there are tries.
begin
Inc(Attempts);
BaseObjects := GatherMiniMapObjects(BasesToCheck);
if ObjDTM_FindEx(Path[i], X, Y, GroundLevel, BaseObjects) then
begin
Found := True;
if InCircle(X, Y, MMCX, MMCY, 75) then //This checks to see if the main-point is actually clickable.
begin
WriteLn('Walking to path node ' + IntToStr(i) + '.');
Mouse(X, Y, 0, 0, True); //Clicks.
Wait(500);
FFlag(FlagDistance); //Waits until the specified distance is reached.
WriteLn('Flag distance reached.');
Result := True;
Break;
end else
begin //If the Object DTM is found, but the main-point is off-screen,
//then we make note of the current position, but don't click.
TrackP.x := X;
TrackP.y := Y;
if not Tracking then
begin
WriteLn('Found path node ' + IntToStr(i) + ', but can' + #39 +
't reach main point. Tracking Object DTM.');
Tracking := True;
end;
if ((Attempts = Tries) and Found) then //If we have reached the maximum number of tries, and the Object DTM
begin //has been found, but still isn't clickable, then we find the closest
//available point and click it.
Theta := arctan2((abs(TrackP.y - MMCY)), (abs(TrackP.x - MMCX)));
if ((TrackP.y - MMCY) < 0) then
YOfQ := (((Floor(74 * sin(Theta))) * -1) + MMCY)
else
YOfQ := ((Floor(74 * sin(Theta))) + MMCY);
if ((TrackP.x - MMCX) < 0) then
XOfQ := (((Floor(74 * cos(Theta))) * -1) + MMCX)
else
XOfQ := ((Floor(74 * cos(Theta))) + MMCX);
Mouse(XOfQ, YOfQ, 0, 0, True);
Wait(500);
WriteLn('Found path node ' + IntToStr(i) + ', but couldn' + #39 +
't reach main point, getting as close as possible.');
FFlag(FlagDistance); //Waits until the specified distance is reached.
Found := True;
Result := True;
Break;
end;
end;
end else
begin
WriteLn('Did not find path node ' + IntToStr(i) + '.');
Found := False;
Result := False;
Wait(PollRate); //If the Object DTM isn't found, then we wait for the specified amount
end; //of time before trying to find it again.
end;
if (not Result) then //If function fails to walk a node, will try to walk to the last found
begin //node, or the next one, to try to recover.
WriteLn('Failed to walk to path node ' + IntToStr(i) + ', trying to step forward or back one node.');
if (ObjDTM_Walk(Path[i - 1], 0, 100, 10, GroundLevel) and (not Reset)) then
begin
Reset := True;
Result := True;
Dec(I);
end;
if (ObjDTM_Walk(Path[i + 1], 0, 100, 10, GroundLevel) and (not Reset)) then
begin
Reset := True;
Result := True;
Inc(I);
end;
end;
end;
if CheckEndPoints then //If 'CheckEndPoints' is true, will check to see if player
begin //is within area polygon of last node. If not, the function
//will result false.
if (not ObjDTM_InArea(Path[High(Path)], GroundLevel)) then
begin
WriteLn('Object DTM Include: Not at end of path.');
Result := False;
end;
end;
end;
procedure ObjectDebug(ObjectToDebug: Integer);
(*******************************************************************************
procedure ObjectDebug(ObjectToDebug: Integer);
By: euphemism
Last Edit: 2 Dec 2011 -- euphemism
Description: Locates all instances of the object 'ObjectToDebug', and paints
numbered boxes over all instances of the object. In the debug,
the function prints out the information needed to use each
found object as a sub-point of an Object DTM.
*******************************************************************************)
var
I: Integer;
BaseString: String;
Colors: TIntegerArray;
TPA: TPointArray;
begin
case ObjectToDebug of
0: BaseString := 'MM_LADDER';
1: BaseString := 'MM_TREE';
2: BaseString := 'MM_DEADTREE';
3: BaseString := 'MM_PLANT';
4: BaseString := 'MM_FLAX';
5: BaseString := 'MM_BOULDER';
6: BaseString := 'MM_HENGE';
7: BaseString := 'MM_CACTUS';
8: BaseString := 'MM_MAPLE';
9: BaseString := 'MM_ROCK';
else
BaseString := 'MM_OBJECT';
end;
Colors := [clBlue, clLime, clRed, clYellow]
TPA := FindMiniMapObj(MMObjRecords[ObjectToDebug]);
{$IFDEF SMART}
SMART_DrawBoxEx(True, IntToBox(0, 0, 1, 1), clBlue);
{$ENDIF}
for I := 0 to High(TPA) do
begin
{$IFDEF SMART}
SMART_DrawBoxEx(False, (IntToBox(TPA[i].x - 3, TPA[i].y - 3, TPA[i].x + 3,
TPA[i].y + 3)), Colors[RandomRange(0, 3)]);
SMART_DrawTextEx(False, (TPA[I].X - 11), (TPA[I].Y - 3),
'SmallChars', IntToStr(I), ClBlue);
SMART_DrawTextEx(False, (TPA[I].X - 12), (TPA[I].Y - 4),
'SmallChars', IntToStr(I), ClWhite);
{$ENDIF}
WriteLn('//////////////////////////////////////////////////////');
WriteLn('');
WriteLn('Minimap object ' + ToStr(I));
WriteLn('-----------------------');
WriteLn('Skeleton Record:');
WriteLn('');
WriteLn(' SubPoints[].Base := ' + BaseString + ';');
WriteLn(' SubPoints[].Drift := 5;');
WriteLn(' SubPoints[].Point.x := ' + IntToStr(TPA[i].x) + ';');
WriteLn(' SubPoints[].Point.y := ' + IntToStr(TPA[i].y) + ';');
WriteLn('');
end;
WriteLn('+++++++++++++++++++++++++++++++++++++++++++++++++++++');
//end;
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
procedure GenerateObjDTMSkeleton(NumberOfSubPoints: Integer; NumberOfAreaVertices: Integer);
(*******************************************************************************
procedure GenerateObjDTMSkeleton(NumberOfSubPoints: Integer; AreaBox: Boolean);
By: euphemism
Last Edit: 22 Nov 2011 -- euphemism
Description: Prints out a skeleton record for an Object DTM with x number of
sub-points, where x is 'NumberOfSubPoints', it will also print
out the area box code to fill in, if you set 'AreaBox' to true.
*******************************************************************************)
var
I: Integer;
begin
WriteLn('with ObjectDTM do');
WriteLn('begin');
WriteLn('');
WriteLn(' MainPoint.x := 627;');
WriteLn(' MainPoint.y := 85;');
WriteLn('');
WriteLn(' NumOfPoints := ' + IntToStr(NumberOfSubPoints) + ';');
if (NumberOfAreaVertices > 0) then
WriteLn(' NumOfAreaPoints := ' + IntToStr(NumberOfAreaVertices) + ';');
WriteLn('');
WriteLn(' SetLength(SubPoints, ' + IntToStr(NumberOfSubPoints) + ');');
if (NumberOfAreaVertices > 0) then
WriteLn(' SetLength(Area, ' + IntToStr(NumberOfAreaVertices) + ');');
WriteLn('');
for I := 0 to (NumberOfSubPoints - 1) do
begin
WriteLn(' SubPoints[' + IntToStr(i) + '].Base := MM_OBJECT;');
WriteLn(' SubPoints[' + IntToStr(i) + '].Drift := 7;');
WriteLn(' SubPoints[' + IntToStr(i) + '].Point.x := 0;');
WriteLn(' SubPoints[' + IntToStr(i) + '].Point.y := 0;');
if I < (NumberOfSubPoints - 1) then
WriteLn('');
end;
if (NumberOfAreaVertices > 0) then
begin
for I := 0 to (NumberOfAreaVertices - 1) do
begin
WriteLn('');
WriteLn(' Area[' + IntToStr(i) + '].x := 0;');
WriteLn(' Area[' + IntToStr(i) + '].y := 0;');
end;
end;
WriteLn('end;');
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
procedure ObjDTM_PrintToRec(ObjectDTMString: String);
(*******************************************************************************
function GenerateObjDTM(Objects: TIntegerArray; MainX, MainY: Integer;
PrintRecord, SortByMainPoint: Boolean): String;
By: euphemism
Last Edit: 3 Jan 2012 -- euphemism
Description: Prints out a useable Object DTM record based on the parameters
passed by the user. Technically, it can make an Object DTM
on-the-fly in its current form, but is limited. Am currently
working on a version that is more automated.
*******************************************************************************)
var
I: Integer;
BaseString: String;
TestObjDTM: ObjDTM;
begin
TestObjDTM := ObjDTMFromString(ObjectDTMString);
WriteLn('Object DTM string converted to record form:');
WriteLn('');
WriteLn('-------------------------------------------');
WriteLn('');
WriteLn('with ObjectDTM do');
WriteLn('begin');
WriteLn('');
WriteLn(' MainPoint.x := ' + IntToStr(TestObjDTM.MainPoint.x) + ';');
WriteLn(' MainPoint.y := ' + IntToStr(TestObjDTM.MainPoint.y) + ';');
WriteLn('');
WriteLn(' NumOfPoints := ' + IntToStr(TestObjDTM.NumOfPoints) + ';');
WriteLn(' SetLength(SubPoints, NumOfPoints);');
WriteLn('');
for I := 0 to (TestObjDTM.NumOfPoints - 1) do
begin
case TestObjDTM.SubPoints[i].Base of
0: BaseString := 'MM_LADDER';
1: BaseString := 'MM_TREE';
2: BaseString := 'MM_DEADTREE';
3: BaseString := 'MM_PLANT';
4: BaseString := 'MM_FLAX';
5: BaseString := 'MM_BOULDER';
6: BaseString := 'MM_HENGE';
7: BaseString := 'MM_CACTUS';
8: BaseString := 'MM_MAPLE';
9: BaseString := 'MM_ROCK';
end;
WriteLn(' SubPoints[' + IntToStr(i) + '].Base := ' +
BaseString + ';');
WriteLn(' SubPoints[' + IntToStr(i) + '].Drift :=' +
IntToStr(TestObjDTM.SubPoints[i].Drift) + ';');
WriteLn(' SubPoints[' + IntToStr(i) + '].Point.x := ' +
IntToStr(TestObjDTM.SubPoints[i].Point.x) + ';');
WriteLn(' SubPoints[' + IntToStr(i) + '].Point.y := ' +
IntToStr(TestObjDTM.SubPoints[i].Point.y) + ';');
WriteLn('');
end;
WriteLn(' NumOfAreaPoints := ' + IntToStr(TestObjDTM.NumOfAreaPoints) + ';');
WriteLn(' SetLength(Area, NumOfAreaPoints);');
WriteLn('');
for I := 0 to (TestObjDTM.NumOfAreaPoints - 1) do
begin
WriteLn(' Area[' + IntToStr(i) + '].x := ' + IntToStr(TestObjDTM.Area[i].x)
+ ';');
WriteLn(' Area[' + IntToStr(i) + '].y := ' + IntToStr(TestObjDTM.Area[i].y)
+ ';');
if ( I <> (TestObjDTM.NumOfAreaPoints - 1)) then
WriteLn('');
end;
WriteLn('end;');
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function IsRealKeyDown(Key: Word): Boolean;
(*******************************************************************************
function IsRealKeyDown(Key: Word): Boolean;
By: Whoever wrote GetRealMousePos, small change by euphemism
Last Edit: 3 Jan 2012 -- euphemism
Description: If using SMART, checks to see if the user is pressing a key
on the keyboard. If not using SMART, the function calls
'IsKeyDown'.
*******************************************************************************)
var
KMTarget, ITarget: Integer;
begin
{$IFDEF SMART}
KMTarget := GetKeyMouseTarget;
ITarget := GetImageTarget;
FindAndSetTarget('Public SMART', True);
Result := GetTClient.IOManager.isKeyDown(Key);
FreeTarget(GetImageTarget);
SetKeyMouseTarget(KMTarget);
SetImageTarget(ITarget);
{$ELSE}
Result := IsKeyDown(Key);
{$ENDIF}
end;
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function FindObjDTM(DTMToFind: String; out cx, cy: Integer;
GroundLevel: Boolean): Boolean;
begin
Result := ObjDTM_Find(DTMToFind, cx, cy, GroundLevel);
end;
function ObjDTMWalk(ObjDTMToWalk: String; FlagDistance, PollRate,
Tries: Integer; GroundLevel: Boolean): Boolean;
begin
Result := ObjDTM_Walk(ObjDTMToWalk, FlagDistance, PollRate, Tries, GroundLevel);
end;