World Tracker 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.