SRL Archive - News and General

If you don't want to wait on the new SRL Revision, replace your Box.scar in SRL/Core/AntiRandoms/Box.scar with the following:

//-----------------------------------------------------------------//
//--               Scar Standard Resource Library                --//
//--               ? Box Routines                                --//
//-----------------------------------------------------------------//
// * function FindBox: Boolean;     // * by WT-Fakawi
// * function GambleBox: Boolean;   // * by WT-Fakawi
// * function GetBoxSide: Integer;  // * by pups
// * function GetQuestion(var num: Integer; var shape: string): Integer; // * by pups
// * function OpenBox: Boolean;     // * by pups
// * function SolveBox: Boolean;    // * by pups


{*******************************************************************************
function FindBox: Boolean;
by: WT-Fakawi
Description: Returns True if Box is found;
*******************************************************************************}

function FindBox : Boolean;
var
  x, y : Integer;
begin
  if FindColorTolerance(x, y, 8750479, MIX1, MIY1, MIX2, MIY2, 20) then
    Result := FindBitmapMaskTolerance(BoxMask, x, y, MIX1, MIY1, MIX2, MIY2, 5, 5);
end;

{*******************************************************************************
function GambleNewBox: Boolean;
by: WT-Fakawi
Description: A random box clicker. Will try to solve the box ONCE, by a random click
             @ any of the three answers. THIS IS NOT A BOXSOLVER, JUST A BOXCLICKER!
*******************************************************************************}

function GambleBox: Boolean;
var
  xb, yb, Choise: Integer;
begin
  if FindBitmapMaskTolerance(BoxMask, xb, yb, MIX1, MIY1, MIX2, MIY2, 5, 5) then
  begin
    Mouse(xb + 8, yb + 8, 0, 0, True);
    Wait(2000);
    Choise:= Random(3);
    TakeScreen('Gambling box Choise - '+IntToStr(Choise));
    case Choise of
      0: Mouse(145, 295, 4, 4, True);
      1: Mouse(270, 295, 4, 4, True);
      2: Mouse(381, 295, 4, 4, True);
    end;
    IdleTime(4000, 2000, 1.0);
    if FindBitmapMaskTolerance(BoxMask, xb, yb, MIX1, MIY1, MIX2, MIY2, 5, 5) then
    begin
      WriteLn('Box Missed');
      NOnewboxes := NOnewboxes + 1;
      Result := False;
      repeat
        Logout;
      until (not (LoggedIn));
      Exit;
    end
    else
    begin
      WriteLn('Box solved');
      newboxes := newboxes + 1;
      Result := True;
    end;
  end;
end;

{*******************************************************************************
function GetBoxSide: Integer;
by: pups
Description: Gets Box side and returns Bitmap
*******************************************************************************}

{function GetBoxSide: Integer;
var
  Side, x, y: Integer;
begin
  Result := 0;
  Side := BitmapFromString(181, 181, '');
  repeat
    wait(100);
    if FindColorTolerance(x, y, 16579837, 182, 45, 182, 225, 5) then continue;
    if FindColorTolerance(x, y, 16579837, 342, 45, 342, 225, 5) then continue;
    if FindColorTolerance(x, y, 16579837, 172, 55, 352, 55, 5) then continue;
    if FindColorTolerance(x, y, 16579837, 172, 215, 352, 215, 5) then continue;
    if FindColorTolerance(x, y, 12764106, 182, 45, 182, 225, 5) then continue;
    if FindColorTolerance(x, y, 12764106, 342, 45, 342, 225, 5) then continue;
    if FindColorTolerance(x, y, 12764106, 172, 55, 352, 55, 5) then continue;
    if FindColorTolerance(x, y, 12764106, 172, 215, 352, 215, 5) then continue;
    Break;
  until False;
  CopyClientToBitmap(Side, 172, 45, 352, 225);
  Result := Side;
end;   }

{Procedure GetBoxSide(pbmp: integer);

Var
   T, bmp, lx, ly, i, cts: Integer;
   P: TPointArray;
   aTPA: T2DPointArray;
   b:tbox;

Begin
  WriteLn('GetBoxSide');
  bmp := BitmapFromstring(500, 320, '');
  cts := GetColorToleranceSpeed;
  ColorToleranceSpeed(2);
  SetColorSpeed2Modifiers(0.06, 0.12);
  T := GetSystemTime;
  While (GetSystemTime - T) < 60000 Do
  Begin
    Wait(100);
    CopyClientToBitmap(bmp, 10, 10, 510, 330);
    //FindColorsTolerance(P, 9737632, 10, 10, 510, 330, 40);
    FindColorsTolerance(P, 8355979, 10, 10, 510, 330, 10);

    aTPA := SplitTPA(P, 20);
    //aTPA := SplitTPA(P, 25);
    SortATPASize(aTPA, True);
    if(length(aTPA) = 1) then
    begin
      Break;
      writeln('breaking 1');
    end;
    if(length(aTPA) = 2) then
      if(length(aTPA[1]) < 20) then
      begin
        Break;
        writeln('breaking 2');
      end;
  End;

  Try
     P := aTPA[0];
     lx := 10000;
     ly := 10000;
     for i := 0 to high(p) do
     begin
       if(lx > p[i].x) then lx := p[i].x;
       if(ly > p[i].y) then ly := p[i].y;
     end;
     B := GetTPABounds(P);
     SafeCopyCanvas(getbitmapcanvas(bmp), getbitmapcanvas(pbmp),
                lx - 10, ly - 10, lx + 220, ly + 220,
                0, 0, 181, 181);

     DisplayDebugImgWindow(0, 0);
     DisplayDebugImgWindow(181, 181);
     SafeDrawBitmap(pbmp, getdebugcanvas, 0, 0);
  Except WriteLn('Bug in Box Solver'); End;
  SetColorSpeed2Modifiers(0.2, 0.2);
  ColorToleranceSpeed(cts);
End;     }

Procedure GetBoxSide(BMP: Integer);

Var
  P: TPointArray;
  DP: T2DPointArray;
  I, Time, oldCTS, Client, W, H: Integer;
  B: Boolean;
  BB: TBox;

Begin
  oldCTS := GetColorToleranceSpeed;
  ColorToleranceSpeed(2);
  SetColorspeed2Modifiers(0.21, 0.13);
  GetClientDimensions(W, H);
  Client := BitmapFromString(W, H, '');

  Time := GetSystemTime;

  While GetSystemTime - Time < 60000 Do
  Begin
    Wait(50);
    CopyClientToBitmap(Client, 0, 0, W, H);
    //FindColorsTolerance(P, 8355979, 3, 3, 515, 336, 20);
    FindColorsTolerance(P, 8355723, 10, 10, 515, 336, 20);
    DP := SplitTPA(P, 4);

    B := False;
    For I := 0 To High(DP) Do
      If (Length(DP[I]) > 50) Then // turn into acc
      Begin
        If B Then
        Begin
          //{$IFDEF BOXDEBUG}WriteLn('Too many big arrays...'); {$ENDIF}
          B := False;
          Break;
        End;
        B := True
      End;
    SortATPASize(DP, True);
    If Not B Then
    Begin
      //{$IFDEF BOXDEBUG}WriteLn('Die! B');{$ENDIF}
      Continue;
    End;
    If Length(DP[0]) < 1000 Then
    Begin
      //{$IFDEF BOXDEBUG}WriteLn('Length');{$ENDIF}
      Continue;
     End;
    WriteLn('We found a flat side');
    Wait(1);
    BB := GetTPABounds(DP[0]);
    DisplayDebugImgWindow(181, 181);

    SafeCopyCanvas(GetBitmapCanvas(Client), GetBitmapCanvas(BMP), BB.X1, BB.Y1,
    BB.X2, BB.Y2, 0, 0, 181, 181);
    {$IFDEF BOXDEBUG}
      DisplayDebugImgWindow(181, 181);
      SafeDrawBitmap(BMP, GetDebugCanvas, 0, 0);
    {$ENDIF}
    Break;
  End;
  ColorToleranceSpeed(oldCTS);
  FreeBitmap(Client);
End;

{*******************************************************************************
function GetQuestion(var num: Integer; var shape: String): Integer;
by: pups
Description: Returns number and type.
*******************************************************************************}

function GetQuestion(var num: Integer; var shape: string): Integer;
var
  x, y, i: Integer;
  text: string;
begin
  Result := 0;
  num := 10;
  shape := '';
  for i := 0 to 14 do
  begin
    case i of
      0: text := '0'; //Zero
      1: text := '1'; //One
      2: text := '2'; //Two
      3: text := '3'; //Three
      4: text := '4'; //Four
      5: text := '5'; //Five
      6: text := '6'; //Six
      7: text := '7'; //Seven
      8: text := '8'; //Eight
      9: text := '9'; //Nine
      10: text := 'Circle'; //Circle
      11: text := 'Triangle'; //Triangle
      12: text := 'Square'; //Square
      13: text := 'Star'; //Star
      14: text := 'Pentagon'; //Pentagon
    end;
    if (FindText(x, y, Text, upchars, 110, 240, 415, 290)) then
    begin
      Result := i;
      if (i < 10) then
        num := i;
      if (i >= 10) then
        shape := text;
      Exit;
    end;
  end;
end;

{*******************************************************************************
function OpenBox: Boolean;
by: pups fixed by Cheesehunk.
Description: Opens the box.
*******************************************************************************}

function OpenBox : Boolean;
var
  x, y, i : Integer;
begin
  Result := False;
  GameTab(4);
  Wait(100 + Random(50));
  if FindBitmapMaskTolerance(BoxMask, x, y, MIX1, MIY1, MIX2, MIY2, 5, 5) then
  begin
    Mouse(x + 8, y + 8, 10, 10, True);
    for i := 0 to 9 do
    begin
      if SimilarColors(GetColor(479, 29), 8042720, 20) then
      begin
        Result := True;
        Exit;
      end;
      Wait(500);
    end;
  end;
end;

{*******************************************************************************
function SolveBox: Boolean;
by: pups
Description: Solves the Box!
*******************************************************************************}

function SolveBox: Boolean;
var
  st2, tries, pbmp: Integer;
  shapeQ, shape, ans: string;
  numQ, num: Integer;
  x, y, z: Integer;
  c: TCanvas;
begin
  z := GetColorToleranceSpeed;
  ColorToleranceSpeed(1);
  tries := 0;
  while OpenBox do
  begin
    pbmp := BitmapFromString(181, 181, '');
    WriteLn('Found a box, solving...');
    Wait(2000);
    WriteLn('Getting question');
    GetQuestion(numQ, shapeQ);
    if (shapeQ = '') and (numQ = 10) then
    begin
      Writeln('Could not identify the BOX question.');
      tries := tries + 1;

      if tries > 20 then
      begin
        LogOut;
        Players[CurrentPlayer].Rand := 'NewBox';
        Players[CurrentPlayer].Active := False;
        ColorToleranceSpeed(z);
        exit;
      end;

      continue;
    end;
    WriteLn('Question is:');
    if shapeQ = '' then
      WriteLn('Which shape has number ' + IntToStr(numQ))
    else
      WriteLn('What number is the ' + shapeQ);
    st2 := GetSystemTime;
    repeat
      GetBoxSide(pbmp);
      wait(1);
      c := GetBitmapCanvas(pbmp);
      if (ScreenShots) then
        SaveBitmap(pbmp, ScriptPath + 'box_debug.bmp');
      Try
      Begin
        WriteLn('ProcessPicture');
        ProcessPicture(c, shape, num, 0);
        WriteLn(Shape + ' : ' + IntToStr(Num));
      End;
      Except
        Begin
          LogOut;
          Players[CurrentPlayer].Rand := 'BOX ERROR';
          Freebitmap(pbmp);
          Exit;
        End;
      End;
      if (num = numQ) or (shape = shapeQ) then
      begin
        if num = numQ then
          ans := shape
        else
          ans := IntToStr(num);
        WriteLn('Answer is ' + ans);
        TakeScreen('Solved box answer - '+Ans);
        if FindText(x, y, ans, upchars, 116, 286, 183, 311) then
          Mouse(120, 290, 30, 10, True);
        if FindText(x, y, ans, upchars, 235, 286, 302, 311) then
          Mouse(240, 290, 30, 10, True);
        if FindText(x, y, ans, upchars, 350, 286, 417, 311) then
          Mouse(355, 290, 30, 10, True);
        NewBoxes := NewBoxes + 1;
        AddToSRLLog('******** SOLVED BOX RANDOM ********');
        WriteLn('******** SOLVED BOX RANDOM ********');
        Result := True;
        Break;
      end;
    until GetSystemTime > st2 + 20000;
    Wait(1500 + Random(1000));
    FreeBitmap(pbmp);
  end;
  ColorToleranceSpeed(z);
end;

Nothing changed in pups' solver. It's fine for now…

Solved 5/6 of the boxes I tried it on. It mistaked a triangle for a pentagon, but it's a lot better now.

<3

Yay! Great! :D
The last box solver did solve some boxes but it had 20 more to solve.. :p
I'll test with this one.

now to get scar -_-'

~shut

Great Job with this Wizzup

Im sure it was well worth the wait!

Thanks a lot for fixing this - I almost always get boxes, for whatever reason.

As a side note, who is Pups?

Pups was a SRL developer that made the box solver. What did you change Wizzup?

does this work i always log into boxes?does it require a bit hcore juice?

anyidea when the next revision is coming out?

~shut

Is this the fix of mysterious box random event?

From: Yo Yoker
Is this the fix of mysterious box random event?

Yes.

Wizzup, i'm afraid but it isnt working well. Just the same as the old one it fails a lot and i've put the box.scar in the current place

From: Colluci
Wizzup, i'm afraid but it isnt working well. Just the same as the old one it fails a lot and i've put the box.scar in the current place

You're the first to name that problem.
Are you at Highest Brightness, 32 bit colours?

Yes i am. Grats on 6000 post btw :P