Results 1 to 12 of 12

Thread: BeeKeeper random solver

  1. #1
    Join Date
    Mar 2007
    Posts
    1,700
    Mentioned
    0 Post(s)
    Quoted
    8 Post(s)

    Default BeeKeeper random solver

    I tried Zeph's out, and it didn't work. So I made this:
    SCAR Code:
    program New;
    {.include SRL/SRL.scar}

    //gametabs
    //8, 9, 10, 11, 13
    //music - horizon

    function Bee_Screen: Boolean;
    begin
      Result := (GetColor(500, 20) = 39423);
    end;

    function Bee_Convo: Boolean;
    var
      i, c, a: integer;
    begin
      for i := 0 to 3 do
      begin
        if Bee_Screen then Break;
        if not ClickContinue(True, True) then
          if not FindTextTpa(0, 0, MCX1, MCY1, MCX2, MCY2, 'Yeah', NPCChars, ClickLeft) then
          begin
            c := CountColor(0, MCX1, MCY1, MCX2, MCY2);
            Mouse(242, 454, 50, 3, True);
            a := GetSystemTime;
            while c = CountColor(0, MCX1, MCY1, MCX2, MCY2) do
            begin
              if GetSystemTime - a > 3000 then Break;
              Wait(100);
            end;
          end;
      end;
      Result := Bee_Screen;
    end;

    function Bee_Part(Pt: TPoint): integer;
    begin
      if PointInBox(Pt, inttobox(27, 31, 133, 79)) then
        Result := 1
      else if PointInBox(Pt, inttobox(27, 80, 133, 129)) then
        Result := 2
      else if PointInBox(Pt, inttobox(27, 130, 133, 175)) then
        Result := 3
      else
        Result := 4;
    end;

    procedure Bee_DragMouse(Pt1, Pt2: TPoint);
    var
      x, y: integer;
    begin
      MMouse(Pt1.x, Pt1.y, 5, 5);
      GetMousePos(x, y);
      HoldMouse(x, y, True);
      Wait(200+Random(100));
      MMouse(Pt2.x, Pt2.y, 10, 10);
      GetMousePos(x, y);
      Wait(200+Random(100));
      ReleaseMouse(x, y, True);
      Wait(100+Random(100));
    end;

    function Bee_Puzzle: Boolean;
    var
      Pt, Pt2: TPoint;
      P: TPointArray;
      aP: T2DPointArray;
      a, CTS, i, L, c, ThePart, Hi: integer;
      Parts, InPlace: TIntegerArray;
    begin
      CTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(1);
      a := GetSystemTime;
      while Length(P) < 10 do
      begin
        if GetSystemTime - a > 5000 then Exit;
        FindColorsTolerance(P, 1250068, 27, 31, 133, 222, 20);
        Wait(50);
      end;
      Pt := MiddleTPA(P);
      Parts := [Bee_Part(Pt)];
      InPlace := [3];
      Bee_DragMouse(Pt, Point(235, 141));

      ColorToleranceSpeed(2);
      SetColorspeed2Modifiers(0.38, 0.13);
      while Length(Parts) < 3 do
      begin
        FindColorsTolerance(P, 4802894, 27, 31, 133, 222, 10);
        aP := SplitTPA(P, 3);
        Hi := High(aP);
        if Hi > 0 then
        begin
          SortATPASize(aP, True);
          L := Length(aP[0]);   writeln(l);
          if (L > 50) or ((Length(Parts) = 2) and (L > 30)) then
          begin
            Pt := MiddleTPA(aP[0]);
            ThePart := Bee_Part(Pt);
            if L < 190 then
            begin
              c := 0;
              for i := 1 to Hi do
                if Bee_Part(MiddleTPA(aP[i])) = ThePart then
                  Inc(c);
              if (c > 1) and (not(InIntArray(InPlace, 4))) then
              begin
                Bee_DragMouse(Pt, Point(243, 196))
                InPlace := CombineIntArray(InPlace, [4]);
              end else
              if (not(InIntArray(InPlace, 2))) and InIntArray(InPlace, 1) then
              begin
                Bee_DragMouse(Pt, Point(252, 97));
                InPlace := CombineIntArray(InPlace, [2]);
              end else
                ThePart := -1;
            end else
            if not InIntArray(InPlace, 1) then
            begin
              Bee_DragMouse(Pt, Point(249, 41));
              InPlace := CombineIntArray(InPlace, [1]);
            end else
              ThePart := -1;
            if ThePart > 0 then
              Parts := CombineIntArray(Parts, [ThePart]);
          end;
        end;
        Wait(300);
      end;
      SetColorspeed2Modifiers(0.2, 0.2);
      ColorToleranceSpeed(CTS);

      for i := 1 to 4 do
        for c := 1 to 4 do
          if not InIntArray(Parts, i) then
            if not InIntArray(InPlace, c) then
            begin
              Pt := Point(80, 55 + (i-1) * 50);
              Pt2 := Point(255, 45 + (c-1) * 50);
              Bee_DragMouse(Pt, Pt2);
              Break;
            end;
           
      c := CountColor(0, MCX1, MCY1, MCX2, MCY2);
      Mouse(270, 275, 10, 5, True);
      a := GetSystemTime;
      while CountColor(0, MCX1, MCY1, MCX2, MCY2) = c do
      begin
        if GetSystemTime - a > 5000 then Break;
        Wait(100);
      end;
      Result := FindTextTpa(0, 0, MCX1, MCY1, MCX2, MCY2, 'move', NPCChars, Nothing);
      if Result then
      begin
        for i := 0 to 1 do
          ClickContinue(True, True);
        a := GetSystemTime;
        while PercentBlackMM = 100 do
        begin
          if GetSystemTime - a > 15000 then Exit;
          Wait(100);
        end;
      end;
    end;

    function SolveBeeKeeper: Boolean;
    begin
      if Bee_Convo then
        Result := Bee_Puzzle;
    end;

    begin
      SetupSRL;
      //bee_puzzle;
      SolveBeeKeeper;
    end.
    Fully tested, works great.
    Thanks cycrosism for lending an account.

  2. #2
    Join Date
    Feb 2007
    Location
    Access Violation at 0x00000000
    Posts
    2,865
    Mentioned
    3 Post(s)
    Quoted
    18 Post(s)

    Default

    Great.

    Seriously, someone should pack up all solved randoms/box solver that were made until now and ready for use, so we can atleast solve SOMETHING.

    Great job again
    Ce ne sont que des gueux


  3. #3
    Join Date
    Apr 2007
    Location
    Perth, Australia
    Posts
    3,926
    Mentioned
    3 Post(s)
    Quoted
    2 Post(s)

    Default

    Huh? How'd you get my solver?

  4. #4
    Join Date
    Jan 2007
    Posts
    8,876
    Mentioned
    123 Post(s)
    Quoted
    327 Post(s)

    Default

    Quote Originally Posted by ZephyrsFury View Post
    Huh? How'd you get my solver?
    LOL! lordsaturn = ?

    Great work saturn!

  5. #5
    Join Date
    Jan 2008
    Location
    Ontario, Canada
    Posts
    7,805
    Mentioned
    5 Post(s)
    Quoted
    3 Post(s)

    Default

    Looks good lordsaturn, both will be tested and the best used.

    This is the case with all of the random solvers.
    Writing an SRL Member Application | [Updated] Pascal Scripting Statements
    My GitHub

    Progress Report:
    13:46 <@BenLand100> <SourceCode> @BenLand100: what you have just said shows you 
                        have serious physchological problems
    13:46 <@BenLand100> HE GETS IT!
    13:46 <@BenLand100> HE FINALLY GETS IT!!!!1

  6. #6
    Join Date
    Apr 2007
    Location
    Perth, Australia
    Posts
    3,926
    Mentioned
    3 Post(s)
    Quoted
    2 Post(s)

    Default

    I finally got an acc in the Bee Keeper random and I've found this solver works a lot better than mine. I've added yours to the Dev SVN, look forward to seeing it in Rev #32.

  7. #7
    Join Date
    Jan 2008
    Location
    Ontario, Canada
    Posts
    7,805
    Mentioned
    5 Post(s)
    Quoted
    3 Post(s)

    Default

    Heh little off topic but saturn is in the svn a lot xD
    Writing an SRL Member Application | [Updated] Pascal Scripting Statements
    My GitHub

    Progress Report:
    13:46 <@BenLand100> <SourceCode> @BenLand100: what you have just said shows you 
                        have serious physchological problems
    13:46 <@BenLand100> HE GETS IT!
    13:46 <@BenLand100> HE FINALLY GETS IT!!!!1

  8. #8
    Join Date
    Apr 2007
    Location
    Perth, Australia
    Posts
    3,926
    Mentioned
    3 Post(s)
    Quoted
    2 Post(s)

    Default

    Quote Originally Posted by Nava2 View Post
    Heh little off topic but saturn is in the svn a lot xD
    Oh really?

    Anyway get on IRC.

  9. #9
    Join Date
    Jan 2008
    Location
    Ontario, Canada
    Posts
    7,805
    Mentioned
    5 Post(s)
    Quoted
    3 Post(s)

    Default

    Hard when I'm on my iPod
    Writing an SRL Member Application | [Updated] Pascal Scripting Statements
    My GitHub

    Progress Report:
    13:46 <@BenLand100> <SourceCode> @BenLand100: what you have just said shows you 
                        have serious physchological problems
    13:46 <@BenLand100> HE GETS IT!
    13:46 <@BenLand100> HE FINALLY GETS IT!!!!1

  10. #10
    Join Date
    Feb 2009
    Posts
    2,155
    Mentioned
    4 Post(s)
    Quoted
    42 Post(s)

    Default

    Quote Originally Posted by Nava2 View Post
    Hard when I'm on my iPod
    off topic question

    u can have scar on your ipod???

  11. #11
    Join Date
    Mar 2007
    Posts
    1,700
    Mentioned
    0 Post(s)
    Quoted
    8 Post(s)

    Default

    Thanks for the update Zeph

    Quote Originally Posted by J_Pizzle View Post
    off topic question

    u can have scar on your ipod???
    Look here:
    http://www.villavu.com/forum/showthread.php?t=43109

    Portable scar coming soon(?).

  12. #12
    Join Date
    Jan 2008
    Location
    Ontario, Canada
    Posts
    7,805
    Mentioned
    5 Post(s)
    Quoted
    3 Post(s)

    Default

    You can't o.O
    Writing an SRL Member Application | [Updated] Pascal Scripting Statements
    My GitHub

    Progress Report:
    13:46 <@BenLand100> <SourceCode> @BenLand100: what you have just said shows you 
                        have serious physchological problems
    13:46 <@BenLand100> HE GETS IT!
    13:46 <@BenLand100> HE FINALLY GETS IT!!!!1

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
  •