Results 1 to 5 of 5

Thread: Frement's OSRS world population tracker (nice usage of Text/Web functions in Simba).

  1. #1
    Join Date
    Sep 2008
    Posts
    754
    Mentioned
    8 Post(s)
    Quoted
    275 Post(s)

    Default Frement's OSRS world population tracker (nice usage of Text/Web functions in Simba).

    This script was all written by Frement, i take no credit for it (i just added some small checks to it).

    Idea came around when i was looking for creating a script that would track world population decrease and increase on oldschool rs, using Simba.

    After i got stuck with the project for a few days, i asked Frement to help me out and show me some small examples that would help me progress and learn.. He went ahead and wrote the entire script in 10 minutes, which i can't thank him enough for it (but on the other hand, i would of loved to accomplish this on my own ).

    Anyway, am posting it here - not expecting anyone to find use for it directly on Runescape (Unless you clan pk and wanna hunt clans that avoid fighting you, this is awesome for tracking their worlds), but, this could help anyone learn slightly advanced ways to grab, handle, trim, pars, loop and debug text data. (No include was used, just Simba).

    i've added some small explanations to the script, based on what i understood (which isn't everything), i also want to take this opportunity and ask, if anyone got some cool functions for text/webpage handling (or different ways to implement the same concept) then please do share i find this subject quite intriguing.

    Just to note, i only added the MsgBox and 'refresh' button (which isn't really a button) to the script, frement wrote the entire base code for it.


    Pastebin V1: http://pastebin.com/GbKiu8QU
    Pastebin V2: http://pastebin.com/rbMWiqtT

    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.

    Attached Files Attached Files
    Quit gaming

  2. #2
    Join Date
    Mar 2014
    Posts
    2
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    Neat

  3. #3
    Join Date
    Jan 2012
    Posts
    1
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    getting a clblack is undeclared?
    Edit: line 99 if that helps
    "Exception in Script: Unknown declaration "clBlack" at line 99, column 36"
    Last edited by noogs22; 08-10-2014 at 12:35 AM.

  4. #4
    Join Date
    Apr 2016
    Posts
    1
    Mentioned
    0 Post(s)
    Quoted
    1 Post(s)

    Default

    I have the same issue. How do we solve this?

  5. #5
    Join Date
    Dec 2013
    Location
    Sweden
    Posts
    269
    Mentioned
    17 Post(s)
    Quoted
    161 Post(s)

    Default

    Quote Originally Posted by Sybren View Post
    I have the same issue. How do we solve this?
    Replace clBlack with 0
    "Once you begin to think, you can't stop."

    Life > 0

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •