Simba Code:
//V2
program worldtracker;
const
ManualRefresh = false;
Sleep_Intervals = 500;
MinCount = 3;
MsgBoxe = true;
WarnCount = 6;
XDistance = 70;
Ydistance = 19;
type
TWorld = record
World, Players: Integer;
end;
TDisplay = record
Surface: Integer;
Width, Height: Integer;
end;
TWorldArray = array of TWorld;
function World(__World, __Players: Integer): TWorld;
begin
Result.World := __World;
Result.Players := __Players;
end;
var
MSGBoXES: boolean;
function SortWorlds(Worlds: TWorldArray): TWorldArray;
var
I, J, K: Integer;
begin
K := 301;
repeat
for I := 0 to High(Worlds) do
begin
if (Worlds[I].World = K) then
begin
Inc(J);
SetLength(Result, J);
Result[J - 1] := Worlds[I];
end;
end;
Inc(K);
until (Length(Result) = Length(Worlds));
end;
function CalculateDifference(LC, CC: TWorldArray): TWorldArray;
var
I: Integer;
begin
SetLength(Result, Length(LC));
for I := 0 to High(LC) do
begin
Result[I] := World(LC[I].World, CC[I].Players - LC[I].Players);
end;
end;
function GetData: string;
var
HTTPClient: Integer;
begin
HTTPClient := InitializeHTTPClient(False);
Result := GetHTTPPage(HTTPClient, 'http://oldschool.runescape.com/c=sn10L0LBNoo/slu');
FreeHTTPClient(HTTPClient);
end;
function GetWorldData: TWorldArray;
var
Pieces, WorldPieces: TStringArray;
I, J: Integer;
begin
Pieces := MultiBetween(GetData, 'e(', '");');
for I := 0 to High(Pieces) do
begin
if (Pos('oldschool', Pieces[I]) > 0) then
begin
WorldPieces := Explode(',', Pieces[I]);
Inc(J);
SetLength(Result, J);
Result[J - 1] := World(StrToInt(WorldPieces[0]), StrToInt(WorldPieces[4]));
end;
end;
end;
function Display(Width, Height: Integer): TDisplay;
begin
Result.Surface := CreateBitmap(Width, Height);
Result.Width := Width;
Result.Height := Height;
DisplayDebugImgWindow(Result.Width, Result.Height);
end;
procedure ClearDisplay(__Display: TDisplay);
begin
FastDrawClear(__Display.Surface, clBlack);
end;
procedure FlushDisplay(__Display: TDisplay);
begin
DrawBitmapDebugImg(__Display.Surface);
end;
procedure FreeDisplay(__Display: TDisplay);
begin
FreeBitmap(__Display.Surface);
end;
procedure DisplayDrawText(__Display: TDisplay; Text, Font: string; X, Y, Color: Integer);
var
TPA: TPointArray;
W, H: Integer;
begin
TPA := TPAFromText(Text, Font, W, H);
OffsetTPA(TPA, Point(X, Y));
DrawTPABitmap(__Display.Surface, TPA, Color);
end;
procedure AnsweredNo;
begin
Writeln('Disabling MsgBox for world Tracking...');
MSGBoXES := false;
end;
procedure DisplayDrawWorldInfo(__Display: TDisplay; World, Players, X, Y: Integer);
var
TPA: TPointArray;
WorldInfos, C, W, W2, H, H2: Integer;
begin
if (Players < 0) then
C := 255;
if (Players = 0) or ((Players < MinCount) and (Players > 0)) then
c := 16777215;
if (Players >= MinCount) then
C := 65280;
TPA := TPAFromText(ToStr(World) + ':', 'SmallChars', W, H);
OffsetTPA(TPA, Point(X, Y));
DrawTPABitmap(__Display.Surface, TPA, clYellow);
TPA := TPAFromText(ToStr(Players), 'SmallChars', W2, H2);
OffsetTPA(TPA, Point(X + W + 2, Y));
DrawTPABitmap(__Display.Surface, TPA, C);
DisplayDrawText(__Display, 'Refresh', 'SmallChars', 120, 365, 16744192);
if (Players >= WarnCount) and (MSGBoXES = true) and (World <> 301) and (world < 381) then
begin
WorldInfos := MessageBox('World: ' + IntToSTr(World) + ' Just went up by: ' + IntToStr(Players) + ' + Players', 'World Notice', 1);
writeln(ToStr(WorldInfos));
case (WorldInfos) of
1: Exit;
2: AnsweredNo;
end;
end;
if (Players <= - WarnCount) and (MSGBoXES = true) and (World <> 301) and (world < 381) then
begin
WorldInfos := MessageBox('World: ' + IntToSTr(World) + ' Just went DOWN by: ' + IntToStr(Players) + ' - Players', 'World Notice', 1);
writeln(ToStr(WorldInfos));
case (WorldInfos) of
1: Exit;
2: AnsweredNo;
end;
end;
end;
procedure DrawWorldData(__Display: TDisplay; Worlds: TWorldArray);
var
I, XOffset, YOffset, X, Y: Integer;
begin
ClearDisplay(__Display);
XOffset := XDistance;
YOffset := YDistance;
DisplayDrawText(__Display, ' OSRS World Tracker - By Frement', 'SmallChars', 30, 10, 16744192);
for I := 0 to High(Worlds) do
begin
DisplayDrawWorldInfo(__Display, Worlds[I].World, Worlds[I].Players, 20 + (XOffset * X), 40 + (YOffset * Y));
Inc(Y);
if (Y > 16) then
begin
Y := 0;
Inc(X);
end;
end;
FlushDisplay(__Display);
end;
var
LastCount, CurrentCount, Diff: TWorldArray;
__Display: TDisplay;
Box1: Tbox;
function FindAndSetTarget(TitlePrefix: string; SetAsTarget: Boolean): Boolean;
var
T: TSysProcArr;
I: Integer;
begin
T := GetProcesses;
for I := High(T) downto 0 do
if Pos(TitlePrefix, T[I].Title) <> 0 then
begin
Result := True;
if SetAsTarget then
SetTarget(T[I]);
Exit;
end;
end;
procedure GetRealMousePos(var X, Y: Integer);
var
KMTarget, ITarget: Integer;
begin
{$IFDEF LAPE}
writeln('GetRealMousePos not implemented yet in SRL-5 Lape!');
TerminateScript;
{$ELSE}
KMTarget := GetKeyMouseTarget;
ITarget := GetImageTarget;
FindAndSetTarget('DebugImgForm', True);
GetTClient.IOManager.GetMousePos(X, Y);
FreeTarget(GetImageTarget);
SetKeyMouseTarget(KMTarget);
SetImageTarget(ITarget);
{$ENDIF}
end;
function IsRealMouseInBox(B: TBox): Boolean;
var
P: TPoint;
begin
GetRealMousePos(P.X, P.Y);
if PointInBox(P, B) then
begin
if ismouseButtonDown(Mouse_left) then
result := true;
end;
end;
procedure OnTerminate;
begin
FreeDisplay(__Display);
end;
procedure refresh;
begin
cleardebug;
LastCount := SortWorlds(GetWorldData);
Sleep(Sleep_Intervals);
CurrentCount := SortWorlds(GetWorldData);
Diff := CalculateDifference(LastCount, CurrentCount);
DrawWorldData(__Display, Diff);
SetTargetBitmap(__Display.Surface);
end;
begin
__Display := Display(300, 395);
AddOnTerminate('OnTerminate');
FindAndSetTarget('DebugImgForm', true);
box1 := IntToBox(120, 380, 403, 350);
MSGBoXES := MsgBoxe;
repeat
if (ManualRefresh = true) then
begin
if IsRealMouseInBox(box1) then
refresh
end
else
refresh;
if IsRealMouseInBox(box1) then
MSGBoXES := true;
until (False);
end.