SRL Archive - Research & Development Lounge

I have created a new version of pixelshift, and need some help testing it.

Instead of calculated the number of pixels that changed afetr so many miliseconds, it removes pixels that changed from an array multiple times until left with pixels that never changed during a givenlength of time.

This will improve off of pixelshift, as it should work with computers that lag alot.

The function:

{$DEFINE SMART}
{$i srl/srl.simba}
{$i srl/srl/misc/paintsmart.simba}


type
  pixelCol = record
    x,y,Color:Integer;
  end;

function newPixelCol(x,y,col:Integer):pixelCol;
begin
  Result.Color := col;
  Result.x := x;
  Result.y := y;
end;

function pixelColInRange(pixelCol1,pixelCol2:pixelCol; tol:Integer):Boolean;
begin
  result := SimilarColors(pixelCol1.Color,pixelCol2.Color,tol);
end;

function locIsSame(pixelCol1,pixelCol2:pixelCol):Boolean;
begin
  result := (pixelCol1.x = pixelCol2.x) and (pixelCol1.y = pixelCol2.y);
end;

function getColArr(b:TBox):array of pixelCol;
var
  width,height,x,y:Integer;
  colArr : array of pixelCol;
  colBitmap,I ,dbg: Integer;
begin
  colBitmap := BitmapFromClient(b.X1,b.Y1,b.X2,b.Y2);
  width := Round(Abs(b.X2-b.X1));
  height := Round(Abs(b.Y2-b.Y1));

  SetArrayLength(colArr,width*height);

  for x := 0 to width-1 do
  begin
    for y := 0 to height-1 do
    begin
      colArr[i] := newPixelCol(x, y, FastGetPixel(colBitmap, x, y));
      inc(i);
    end;
  end;
  result := colArr;
end;

function arrayCopy(cols: array of pixelCol;sx,ex:Integer):array of pixelCol;
var
  newArr : array of pixelCol;
  I : Integer;
begin
  SetLength(newArr,(ex-sx));
  for I := 0 to length(newArr)-1 do
    newArr[I] := cols[sx+I];
  result := newArr;
end;

function pixelIntersect(colArr1,colArr2:array of pixelCol; boundingBox : TBox; tol:Integer):array of pixelCol;
var
  pixels : T2DIntegerArray;
  x1,x2,y1,y2,I,II
  ,curIndex,boundingWidth:Integer;
  smallArr,largeArr,intersectArr : array of pixelCol;
begin
  curIndex := 0;
  boundingWidth := boundingBox.X2-boundingBox.X1;
  if (length(colArr1) < length(colArr2)) then
  begin
    smallArr := colArr1;
    largeArr := colArr2;
  end else
  begin
    smallArr := colArr2;
    largeArr := colArr1;
  end;

  writeln(smallArr);
  writeln(largearr);

  SetArrayLength(intersectArr,length(largeArr));

  writeln('1: '+inttostr(length(smallArr)));
  writeln('2: '+inttostr(length(largeArr)));
  while true do
  begin
    if (locIsSame(smallArr[I],largeArr[II])) then
    begin
      if pixelColInRange(smallArr[I],largeArr[II],tol) then
      begin
        intersectArr[curIndex] := smallArr[I];
        curIndex := curIndex+1;
      end;
    end;
    if ((smallArr[I].x*boundingWidth+smallArr[I].y)
         < (largeArr[II].x*boundingWidth+largeArr[II].y)) and (I < (Length(smallArr)-1)) then
    begin
      inc(I)
    end else if ((smallArr[I].x*boundingWidth+smallArr[I].y)
         >= (largeArr[II].x*boundingWidth+largeArr[II].y)) and (II < (Length(largeArr)-1)) then
    begin
      Inc(II);
    end else
      break;
  end;
  result := arrayCopy(intersectArr, 0, Max(0,curIndex));
end;

function calcPixShift(b:TBox;interval,repetitions,tol:Integer):Integer;
var
  staticPixels : TPointArray;
  T,tt : LongInt;
  StaticColArr, TempColArr : array of pixelCol;
  I : Integer;
begin
  StaticColArr := getColArr(b);
  MarkTime(T);
  tt := T;
  for I := 0 to repetitions-1 do
  begin
    TempColArr := getColArr(b);
    StaticColArr := pixelIntersect(StaticColArr,TempColArr,b,tol);
    writeln('pixIntersectCalc time: '+inttostr(timefrommark(tt)));
    if (TimeFromMark(T) > (repetitions*interval)) then
    begin
      writeln('Completed only ' + IntToStr(i+1) + ' of '
        + IntToStr(repetitions) + '. Try increasing the interval');
      break;
    end;
    if I < repetitions-1 then
    begin
      wait(Max(0,interval-TimeFromMark(tt)));
      MarkTime(tt);
    end;
  end;
  for I := 0 to length(StaticColArr)-1 do
    SMART_DrawDot(false,Point(StaticColArr[i].x+b.x1,StaticColArr[i].y+b.y1),clRed);
  result := ((b.X2-b.X1)*(b.Y2-b.Y1))-length(StaticColArr);
end;



begin
  {$ifdef SMART}
    Smart_Members := True;
    Smart_Server := 100;
    Smart_Signed := False;
    Smart_SuperDetail := False;
   writeln('hiiii');
  {$endif}
  SetupSRL;

 writeln(calcPixShift(IntToBox(250,100,270,120),3000,10,0));
end.

Its quite slow I ran a couple of tests and 1 iteration on a 200 by 200 box took 10k ticks and 7k ticks when u tell it not to spam the array in the chat box.

I just watched the code really quickly, but here's what I think I see.

Everytime you find pixels that didn't change, you copy them all to a new array. Did I read that correctly? If so the amount of time you save by reading an array getting smaller and smaller is negated by the fact that you need to keep copying the arrays over and over. It does get faster, but it is partialy because everytime, you have less to copy.

Also there some place you could do optimisation.

{$DEFINE SMART}
{$i srl/srl.simba}
{$i srl/srl/misc/paintsmart.simba}


type
  pixelCol = record
    x,y,Color:Integer;
  end;

function newPixelCol(x,y,col:Integer):pixelCol;
begin
  Result.Color := col;
  Result.x := x;
  Result.y := y;
end;

function pixelColInRange(pixelCol1,pixelCol2:pixelCol; tol:Integer):Boolean;
begin
  result := SimilarColors(pixelCol1.Color,pixelCol2.Color,tol);
end;

function locIsSame(pixelCol1,pixelCol2:pixelCol):Boolean;
begin
  result := (pixelCol1.x = pixelCol2.x) and (pixelCol1.y = pixelCol2.y);
end;

function getColArr(b:TBox):array of pixelCol;
var
  width,height,x,y:Integer;
  colArr : array of pixelCol;
  colBitmap,I ,dbg: Integer;
begin
  colBitmap := BitmapFromClient(b.X1,b.Y1,b.X2,b.Y2);
  width := Round(Abs(b.X2-b.X1));
  height := Round(Abs(b.Y2-b.Y1));

  SetArrayLength(colArr,width*height);

  for x := 0 to width-1 do
  begin
    for y := 0 to height-1 do
    begin
      colArr[i] := newPixelCol(x, y, FastGetPixel(colBitmap, x, y));
      inc(i);
    end;
  end;
  result := colArr;
end;

function arrayCopy(cols: array of pixelCol;sx,ex:Integer):array of pixelCol;
var
  newArr : array of pixelCol;
  I, lengthOptimisation: Integer;
begin
  SetLength(newArr,(ex-sx));
  lenghtOptimisation:=  length(newArr);        // optimisation here.

  for I := 0 to length(newArr)-1 do
    newArr[I] := cols[sx+I];
  result := newArr;
end;

function pixelIntersect(colArr1,colArr2:array of pixelCol; boundingBox : TBox; tol:Integer):array of pixelCol;
var
  pixels : T2DIntegerArray;
  x1,x2,y1,y2,I,II
  ,curIndex,boundingWidth:Integer;
  smallArr,largeArr,intersectArr : array of pixelCol;
begin
  curIndex := 0;
  boundingWidth := boundingBox.X2-boundingBox.X1;
  if (length(colArr1) < length(colArr2)) then
  begin
    smallArr := colArr1;
    largeArr := colArr2;
  end else
  begin
    smallArr := colArr2;
    largeArr := colArr1;
  end;

  writeln(smallArr);
  writeln(largearr);

  SetArrayLength(intersectArr,length(largeArr));

  writeln('1: '+inttostr(length(smallArr)));
  writeln('2: '+inttostr(length(largeArr)));
  while true do
  begin
    if (locIsSame(smallArr[I],largeArr[II])) then
    begin
      if pixelColInRange(smallArr[I],largeArr[II],tol) then
      begin
        intersectArr[curIndex] := smallArr[I];
        curIndex := curIndex+1;
      end;
    end;
    if ((smallArr[I].x*boundingWidth+smallArr[I].y)
         < (largeArr[II].x*boundingWidth+largeArr[II].y)) and (I < (Length(smallArr)-1)) then
    begin
      inc(I)
    end else if ((smallArr[I].x*boundingWidth+smallArr[I].y)
         >= (largeArr[II].x*boundingWidth+largeArr[II].y)) and (II < (Length(largeArr)-1)) then
    begin
      Inc(II);
    end else
      break;
  end;
  result := arrayCopy(intersectArr, 0, Max(0,curIndex));      // Copying an array, now that looks coputer intensive.
end;

function calcPixShift(b:TBox;interval,repetitions,tol:Integer):Integer;
var
  staticPixels : TPointArray;
  T,tt : LongInt;
  StaticColArr, TempColArr : array of pixelCol;
  I : Integer;
begin
  StaticColArr := getColArr(b);
  MarkTime(T);
  tt := T;
  for I := 0 to repetitions-1 do
  begin
    TempColArr := getColArr(b);
    StaticColArr := pixelIntersect(StaticColArr,TempColArr,b,tol);
    writeln('pixIntersectCalc time: '+inttostr(timefrommark(tt)));
    if (TimeFromMark(T) > (repetitions*interval)) then
    begin
      writeln('Completed only ' + IntToStr(i+1) + ' of '
        + IntToStr(repetitions) + '. Try increasing the interval');
      break;
    end;
    if I < repetitions-1 then
    begin
      wait(Max(0,interval-TimeFromMark(tt)));
      MarkTime(tt);
    end;
  end;


  for I := 0 to length(StaticColArr)-1 do      // Again we shoudl do optimisation here
    SMART_DrawDot(false,Point(StaticColArr[i].x+b.x1,StaticColArr[i].y+b.y1),clRed);           // Drawing takes alot of time, this should only be used for debuging.
  result := ((b.X2-b.X1)*(b.Y2-b.Y1))-length(StaticColArr);    // We could send the variable used to store the length we would have created for the previous optimisation
end;

begin
  {$ifdef SMART}
    Smart_Members := True;
    Smart_Server := 100;
    Smart_Signed := False;
    Smart_SuperDetail := False;
   writeln('hiiii');
  {$endif}
  SetupSRL;

 writeln(calcPixShift(IntToBox(250,100,270,120),3000,10,0));
end.

It might not seem like a big deal but when a loop execute the same code a million time it adds up.
Also drawing should slow this down significantly. I suggest using it only for debug.

Yes the iterations should get faster later on but the first one is still too large to be used within a script in my opinion. Here i just ran it at 5 iterations and it does decrease but not by much

pixIntersectCalc time: 6318
pixIntersectCalc time: 5913
pixIntersectCalc time: 5756
pixIntersectCalc time: 5694
pixIntersectCalc time: 5648

Hmm i get about 2 seconds for the box i had in the script.

I agree it is too slow right now. Working on enhancing speed.

It did 15x15 pixel squares in a few seconds a few days ago lol.

Even two seconds is too long for most scripts IMO, but as pixelshift is fast, so can this be.

Thinking instead of array copying, maybe re validating an array and setting entries to a null point of it changed.

Ive had a play around and made one myself and tested it a bit and its actually not that bad

{$i srl/srl.simba}

 function GetColorArray(Box:TBox):Array of TIntegerArray;

 var
  x,y:Integer;
  arr:Array of TIntegerArray;
  bitmap:Integer;

 begin
  bitmap:=BitmapFromClient(Box.X1,Box.Y1,Box.X2,Box.Y2);
  SetArrayLength(arr,Box.X2-Box.X1);
  for x := 0 to Length(Arr)-1 do
  begin
    SetArrayLength(arr[x],Box.Y2-Box.Y1);
    for y := 0 to Length(arr[x])-1 do
      arr[x][y]:=FastGetPixel(bitmap,x,y);
  end;
  FreeBitmap(Bitmap);
  Result:=arr;
 end;

 function CompareColorArray(a,b:Array of TIntegerArray;var BlackList:Array of TBooleanArray):Integer;
 var
  x,y,c:Integer;
 begin
  c:=0;
  for x:=0 to Length(a)-1 do
  begin
    for y := 0 to Length(a[x])-1 do
      begin
        if(BlackList[x][y]=True)then
          continue;
        if(a[x][y]<>b[x][y])then
          begin
            Inc(c);
            BlackList[x][y]:=True;
          end;
      end;
  end;
  Result:=c;
 end;

 function getBlackListSize(BlackList:Array of TBooleanArray):Integer;

 var
  x,y,c:Integer;

 begin
  c:=0;
  for x:=0 to GetArrayLength(BlackList)-1 do
    begin
      for y:=0 to GetArrayLength(BlackList[x])-1 do
        begin
          if(BlackList[x][y]) then
            Inc(c);
        end;
    end;
  writeln('BlackList Size: ' + IntToStr(c));
 end;

function PixelShiftNew(Time,Checks:Integer;Box:TBox):Integer;

 var
  i,c:Integer;
  cur,temp:Array of TIntegerArray;
  blackList:Array of TBooleanArray;

 begin
  SetArrayLength(blackList,Box.X2-Box.X1);
  for i:=0 to Box.X2-Box.X1-1 do
    SetArrayLength(blackList[i],Box.Y2-Box.Y1);
  cur:=GetColorArray(Box);
  c:=0;
  for I:=0 to Checks-1 do
    begin
      wait(Time/Checks);
      temp:=GetColorArray(Box);
      c:=c+CompareColorArray(cur,temp,blackList);
      cur:=temp;
    end;
  //getBlackListSize(BlackList);
  Result:=c;
 end;

 var

  a,c,i,pix,tick:Integer;

 begin
  for a:=1 to 10 do
    begin
    c:=0;
    i:=0;
      repeat
        tick:=GetTickCount;
        pix:=PixelShiftNew(0,1,IntToBox(0,0,a*10,1));
        tick:=GetTickCount-tick;
        c:=c+tick;
        Inc(i);
        wait(1);
      until (i=25)
    writeln('Pixels: '+IntToStr(a*10*1000)+' Average Ticks: '+IntToStr(c/i));
    end;
 end.  

Get blacklist size was just to check it was correctly blacklisting things and the last method is what i was using to benchmark it.

The attached photo is the benchmark data i couldn't be bothered testing past 40k pixels it was taking too long.

Anyway it could do with being optimized and cleaned up but try it and see what you think.

Ooh great idea, using a bool array to limit the check.

Lets see what that does to improve the function