Simba Code:
program new;
{$DEFINE SMART}
{$DEFINE DEBUG_ON}
{$DEFINE SMART}
{$i srl-6/srl.simba}
// -----------------------------------------------------------------------------
// -- libcolorizer.simba
// -- Written by: bonsai
// -----------------------------------------------------------------------------
{$f-}
const
BLACKLIST_THRESHOLD = 400; // msec. if a findcolor takes longer than this we dont want it
PIXELSHIFT_WAIT = 350; // msec
SUCCESS_THRESHOLD = 0.75; // what is good enough (percent) to call a color successful
FAILURE_THRESHOLD = 0.30; // what is bad enough (percent) to call a failure
ATTEMPT_THRESHOLD = 25; // by this many attempts, demand success or blacklist
GRIDSIZE = 50; // box size to break up the screen for motion detection
CLEANUP_LOW_WATER = 40; // how many colors to keep if we are cleaning up
type
TcolRec = record
color : integer;
count : integer; // how many times have we seen this color
attempts : integer; // how many times have we tried this color
matches : integer; // how many attempts made a match
maxPoints : integer; // max points returned when finding this color
maxObj : integer; // max objects found when finding this color
queryTime : integer; // how long did it take to find this color
end;
TcolSet = array of TcolRec;
Tcolorizer = record
name : string; // a name for this object, used as file name in load/save
discovered : TcolSet; // colors we have discovered that may be relevant
active : TcolSet; // colors we are testing to see if they are worthy
successful : TcolSet; // colors that worked
blacklist : TcolSet; // colors that suck for one reason or another
runty : TcolSet; // colors that return too few points, maybe good matches?
uptext : string; // uptext of the object we are colorizing
uptextTimeout : integer; // how long to wait for an uptext to display before moving on
tol : integer; // tolerance on color search (cts 0)
dist : integer; // distance for object making (tpa split)
minPixels : integer; // min pixels to keep an object
maxPixels : integer; // objects bigger than this get tossed
end;
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
// Some functions that had issues or were missing from SRL
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
function getPixelShiftAverage(b: TBoxArray; waitPerLoop, maxTime: integer): TIntegerArray; override;
var
len, i, j: integer;
samples: array of TIntegerArray;
tmp: TIntegerArray;
timer: TTimeMarker;
begin
i := 0;
timer.start();
while (timer.getTime() < maxTime) do
begin
setLength(samples, i + 1);
samples[i] := getPixelShift(b, waitPerLoop);
inc(i);
end;
setLength(tmp, i); // i got incremented one extra time so is good for length
len := length(b);
setLength(result, len);
for i := 0 to (len - 1) do
begin
for j := 0 to high(samples) do
tmp[j] := samples[j][i];
result[i] := tmp.average();
end;
end;
function getPixelShift(b: TBoxArray; time: integer): TIntegerArray; override;
var
hi, i: integer;
before, after: integer;
begin
hi := high(b);
setLength(result, hi+1);
before := bitmapFromClient(mainscreen.getBounds());
sleep(time);
after := bitmapFromClient(mainscreen.getBounds());
for i := 0 to hi do
result[i] := calculatePixelShift(before, after, b[i]);
freeBitmap(before);
freeBitmap(after);
end;
function TIntegerArray.max(): integer;
var
i, tmpmax: integer;
begin
tmpmax := -(MAXINT);
for i := 0 to length(self) do
if self[i] > tmpmax then tmpmax := self[i];
exit(tmpmax);
end;
function TBoxArray.pixelShift(time: integer = 200): TIntegerArray;
begin
result := getPixelShift(self, time);
end;
function TBoxArray.returnInArray(const b : TBox) : integer;
var
i: integer;
begin
for i := 0 to high(self) do
if (self[i].equals(b)) then exit(i);
exit(-1);
end;
function TBoxArray.isInArray(const b : TBox) : Boolean;
begin
if (self.returnInArray(b) <> -1) then
result := true
else
result := false;
end;
procedure TBoxArray.addIndex(const b : TBox; const index : Integer);
var
I : Integer;
begin
if not inRange(index, low(self), length(self)) then
begin
WriteLn('ERROR: addIndex: index larger than array length.');
Exit;
end;
setLength(self, length(self)+1);
for I := high(self)-1 downto index do
self[I+1] := self[I];
self[index] := b;
end;
procedure TBoxArray.append(const b : TBox);
begin
self.addIndex(b, length(self));
end;
procedure TBoxArray.combine(const arr : TBoxArray);
var
i : integer;
begin
for i := 0 to high(arr) do
self.append(arr[i]);
end;
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
// sortByCount()
//
// sorts the array by count desc
// -----------------------------------------------------------------------------
procedure TcolSet.sortByCount();
var
i, j, m: integer;
tmp: TcolSet;
begin
setLength(tmp, 1);
for i := 0 to high(self) - 1 do
begin
m := i;
for j := i + 1 to high(self) do
begin
if self[j].count > self[m].count then
m := j;
end;
tmp[0] := self[m];
self[m] := self[i];
self[i] := tmp[0];
end;
end;
// -----------------------------------------------------------------------------
// sortBySuccess()
//
// sorts the array by success rate desc
// -----------------------------------------------------------------------------
procedure TcolSet.sortBySuccess();
var
i, j, m: integer;
tmp: TcolSet;
begin
setLength(tmp, 1);
for i := 0 to high(self) - 1 do
begin
m := i;
for j := i + 1 to high(self) do
begin
if (self[j].matches / self[j].attempts) > (self[m].matches / self[m].attempts) then
m := j;
end;
tmp[0] := self[m];
self[m] := self[i];
self[i] := tmp[0];
end;
end;
// -----------------------------------------------------------------------------
// returnInArray()
//
// Returns the index of color c in the array (-1 if not found)
// -----------------------------------------------------------------------------
function TcolSet.returnInArray(const c: integer): integer;
var
i: integer;
begin
for i := 0 to high(self) do
if (self[i].color = c) then exit(i);
exit(-1);
end;
// -----------------------------------------------------------------------------
// isInArray()
//
// Returns true if color c in the array
// -----------------------------------------------------------------------------
function TcolSet.isInArray(const c: integer): boolean;
var
i: integer;
begin
i := self.returnInArray(c);
if (i = -1) then
result := false
else
result := true;
end;
// -----------------------------------------------------------------------------
// append()
//
// Adds a color to the array
// -----------------------------------------------------------------------------
procedure TcolSet.append(const t: TcolRec);
var
i: integer;
begin
setLength(self, (length(self) + 1));
self[high(self)] := t;
end;
// -----------------------------------------------------------------------------
// deleteIndex()
//
// Deletes the color at the given index
// -----------------------------------------------------------------------------
procedure TcolSet.deleteIndex(const index: integer);
var
i : integer;
begin
if not inRange(index, low(self), high(self)) then
begin
writeln('TcolSet.deleteIndex: ERROR - index (', index, ' is out of range');
exit;
end;
for i := index to (high(self) - 1) do
self[i] := self[i + 1];
setLength(self, (length(self) - 1));
end;
// -----------------------------------------------------------------------------
// delete()
//
// Deletes the color
// -----------------------------------------------------------------------------
procedure TcolSet.delete(const c: integer);
var
i : integer;
begin
i := self.returnInArray(c);
if (i >= 0) then
self.deleteIndex(i);
end;
// -----------------------------------------------------------------------------
// cleanupColors()
//
// Weeds down the color list
// -----------------------------------------------------------------------------
procedure TcolSet.cleanupColors();
var
i, t, cnt: integer;
tmp: TcolSet;
begin
cnt := 1;
while (cnt < 15) do
begin
if (length(self) < CLEANUP_LOW_WATER) then exit;
t := 0;
setLength(tmp, length(self));
for i := 0 to high(self) do
begin
if ((self[i].matches > 0) or (self[i].count > cnt)) then
begin
tmp[t] := self[i];
inc(t);
end;
end;
setLength(tmp, t);
self := tmp;
inc(cnt);
end;
end;
// -----------------------------------------------------------------------------
// _fpath()
//
// Loads previous work from a file
// -----------------------------------------------------------------------------
function Tcolorizer._fpath(): string;
var
s: string;
begin
if (self.name = '') then
begin
result := '';
exit;
end;
s := lowercase(self.name);
s := replace(s, ' ', '-', [rfReplaceAll]);
s := replace(s, '/', '-', [rfReplaceAll]);
s := replace(s, ':', '-', [rfReplaceAll]);
result := includePath + 'bonsai\colors\';
if (not DirectoryExists(result)) then
begin
if (CreateDirectory(result)) then
writeln('***** Tcolorizer._fpath: created include folder ' + result)
else
writeln('***** Tcolorizer._fpath: ERROR - Could not create directory ' + result);
end;
result := result + s + '.xml';
end;
// -----------------------------------------------------------------------------
// load()
//
// Loads previous work from a file
// -----------------------------------------------------------------------------
function Tcolorizer.load(): boolean;
var
fileId, i, j, k: integer;
filePath, fileData: string;
allData, colArr, colorSets, cRec: TStringArray;
tmp: TcolRec;
begin
result := false;
filePath := self._fpath();
if (not FileExists(filePath)) then
begin
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer.load: Requested file does not exist [', filePath, ']'); {$ENDIF}
exit;
end;
fileId := OpenFile(filePath, false);
if (fileId = -1) then
begin
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer.load: OpenFile failed [', filePath, ']'); {$ENDIF}
exit;
end;
if (not ReadFileString(fileId, fileData, FileSize(fileId))) then
begin
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer.load: ReadFileString failed [', filePath, ']'); {$ENDIF}
exit;
end;
CloseFile(fileId);
// now we have the contents in fileData, parse it
allData := MultiBetween(fileData, '<colorizer>', '</colorizer>');
if (length(allData) <> 1) then
begin
writeln('***** Tcolorizer.load: Corrupt file [', filePath,
'], does not have proper <colorizer></colorizer> tags');
exit;
end;
self.name := between('<name>', '</name>', allData[0]);
self.uptext := between('<uptext>', '</uptext>', allData[0]);
uptextTimeout := StrToIntDef(between('<uptextTimeout>', '</uptextTimeout>', allData[0]), 0);
tol := StrToIntDef(between('<tol>', '</tol>', allData[0]), 0);
dist := StrToIntDef(between('<dist>', '</dist>', allData[0]), 0);
minPixels := StrToIntDef(between('<minPixels>', '</minPixels>', allData[0]), 0);
maxPixels := StrToIntDef(between('<maxPixels>', '</maxPixels>', allData[0]), 0);
colorSets := ['discovered', 'active', 'successful', 'blacklist', 'runty'];
for i := 0 to high(colorSets) do
begin
colArr := multiBetween(allData[0], '<' + colorSets[i] + '>', '</' + colorSets[i] + '>');
for j := 0 to high(colArr) do
begin
cRec := multiBetween(colArr[j], '<colorRecord>', '</colorRecord>');
for k := 0 to high(cRec) do
begin
tmp.color := StrToIntDef(between('<color>', '</color>', cRec[k]), 0);
tmp.count := StrToIntDef(between('<count>', '</count>', cRec[k]), 0);
tmp.attempts := StrToIntDef(between('<attempts>', '</attempts>', cRec[k]), 0);
tmp.matches := StrToIntDef(between('<matches>', '</matches>', cRec[k]), 0);
tmp.maxPoints := StrToIntDef(between('<maxPoints>', '</maxPoints>', cRec[k]), 0);
tmp.maxObj := StrToIntDef(between('<maxObj>', '</maxObj>', cRec[k]), 0);
tmp.queryTime := StrToIntDef(between('<queryTime>', '</queryTime>', cRec[k]), 0);
case colorSets[i] of
'discovered' : begin; self.discovered.append(tmp); end;
'active' : begin; self.active.append(tmp); end;
'successful' : begin; self.successful.append(tmp); end;
'blacklist' : begin; self.blacklist.append(tmp); end;
'runty' : begin; self.runty.append(tmp); end;
end;
end;
end;
end;
end;
// -----------------------------------------------------------------------------
// save()
//
// Saves the accumulated data
// -----------------------------------------------------------------------------
procedure Tcolorizer.save();
var
s, filePath: string;
i, j, fileId: integer;
colorSets: TstringArray;
function colRec(r: TcolRec): string;
begin
result := result + ' <colorRecord>';
result := result + '<color>' + intToStr(r.color) + '</color>';
result := result + '<count>' + intToStr(r.count) + '</count>';
result := result + '<attempts>' + intToStr(r.attempts) + '</attempts>';
result := result + '<matches>' + intToStr(r.matches) + '</matches>';
result := result + '<maxPoints>' + intToStr(r.maxPoints) + '</maxPoints>';
result := result + '<maxObj>' + intToStr(r.maxObj) + '</maxObj>';
result := result + '<queryTime>' + intToStr(r.queryTime) + '</queryTime>';
result := result + '</colorRecord>' + #13#10;
end;
begin
s := s + '<colorizer>' + #13#10;
s := s + ' <name>' + self.name + '</name>' + #13#10;
s := s + ' <uptext>' + self.uptext + '</uptext>' + #13#10;
s := s + ' <uptextTimeout>' + intToStr(self.uptextTimeout) + '</uptextTimeout>' + #13#10;
s := s + ' <tol>' + intToStr(self.tol) + '</tol>' + #13#10;
s := s + ' <dist>' + intToStr(self.dist) + '</dist>' + #13#10;
s := s + ' <minPixels>' + intToStr(self.minPixels) + '</minPixels>' + #13#10;
s := s + ' <maxPixels>' + intToStr(self.maxPixels) + '</maxPixels>' + #13#10;
colorSets := ['discovered', 'active', 'successful', 'blacklist', 'runty'];
for i := 0 to high(colorSets) do
case colorSets[i] of
'discovered':
begin
s := s + ' <discovered>' + #13#10;
for j := 0 to high(self.discovered) do
s := s + colRec(self.discovered[j]);
s := s + ' </discovered>' + #13#10;
end;
'active':
begin
s := s + ' <active>' + #13#10;
for j := 0 to high(self.active) do
s := s + colRec(self.active[j]);
s := s + ' </active>' + #13#10;
end;
'successful':
begin
s := s + ' <successful>' + #13#10;
for j := 0 to high(self.successful) do
s := s + colRec(self.successful[j]);
s := s + ' </successful>' + #13#10;
end;
'blacklist':
begin
s := s + ' <blacklist>' + #13#10;
for j := 0 to high(self.blacklist) do
s := s + colRec(self.blacklist[j]);
s := s + ' </blacklist>' + #13#10;
end;
'runty':
begin
s := s + ' <runty>' + #13#10;
for j := 0 to high(self.runty) do
s := s + colRec(self.runty[j]);
s := s + ' </runty>' + #13#10;
end;
end;
s := s + '</colorizer>' + #13#10;
filePath := self._fpath();
fileId := RewriteFile(filePath, false);
if (fileId = -1) then
begin
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer.save: RewriteFile failed [', filePath, ']'); {$ENDIF}
exit;
end;
if (not WriteFileString(fileId, s)) then
begin
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer.save: WriteFileString failed [', filePath, ']'); {$ENDIF}
exit;
end;
CloseFile(fileId);
end;
// -----------------------------------------------------------------------------
// init()
//
// Initialize the object
// -----------------------------------------------------------------------------
procedure Tcolorizer.init(nm: string; ut: string; utt: integer; t: integer;
d: integer; minp: integer; maxp: integer);
begin
self.name := nm;
self.uptext := ut;
self.uptextTimeout := utt;
self.tol := t;
self.dist := d;
self.minPixels := minp;
self.maxPixels := maxp;
setLength(self.discovered, 0);
setLength(self.active, 0);
setLength(self.successful, 0);
setLength(self.blacklist, 0);
setLength(self.runty, 0);
end;
// -----------------------------------------------------------------------------
// setName()
//
// Initialize the object
// -----------------------------------------------------------------------------
procedure Tcolorizer.setName(nm: string);
begin
self.name := nm;
end;
// -----------------------------------------------------------------------------
// updateCount()
//
// Updates count info for a color. Adds it if new.
// -----------------------------------------------------------------------------
procedure Tcolorizer.updateCount(col: integer; cnt: integer);
var
d, a, s, b, r: integer;
begin
d := self.discovered.returnInArray(col);
a := self.active.returnInArray(col);
s := self.successful.returnInArray(col);
b := self.blacklist.returnInArray(col);
r := self.runty.returnInArray(col);
if (d+a+s+b+r = -5) then // this is a new color
begin
setLength(self.discovered, length(self.discovered) + 1);
with self.discovered[high(self.discovered)] do
begin
color := col;
count := cnt;
attempts := 0;
matches := 0;
maxPoints := 0;
maxObj := 0;
queryTime := 0;
end;
end
else
begin
if (d >= 0) then
self.discovered[d].count := self.discovered[d].count + cnt;
if (a >= 0) then
self.active[a].count := self.active[a].count + cnt;
if (s >= 0) then
self.successful[s].count := self.successful[s].count + cnt;
if (b >= 0) then
self.blacklist[b].count := self.blacklist[b].count + cnt;
if (r >= 0) then
self.runty[r].count := self.runty[r].count + cnt;
end;
end;
// -----------------------------------------------------------------------------
// updateTrials()
//
// Records success/failure of an attempt to use a color. Will move the
// color from place to place depending on the situation.
// -----------------------------------------------------------------------------
procedure Tcolorizer.updateTrials(col: integer; success: boolean);
var
d, a, s, b, r: integer;
pct: extended;
begin
d := self.discovered.returnInArray(col);
a := self.active.returnInArray(col);
s := self.successful.returnInArray(col);
b := self.blacklist.returnInArray(col);
r := self.runty.returnInArray(col);
if (d+a+s+b+r = -5) then
begin
writeln('Tcolorizer.updateTrials: ERROR - Asked to update color, ', col, ' - does not exist');
exit;
end
if (d >= 0) then
with self.discovered[d] do
begin
inc(attempts);
if (success) then inc(matches);
// move it to active since it is being used.
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer.updateTrials: moving (', self.discovered[d].color, ') discovered -> active'); {$ENDIF}
self.active.append(self.discovered[d]);
self.discovered.deleteIndex(d);
end;
if (a >= 0) then
with self.active[a] do
begin
inc(attempts);
if (success) then inc(matches);
pct := matches / attempts;
// see if this active color has met criteria for blacklist or success
if ((attempts >= ATTEMPT_THRESHOLD) and (pct < SUCCESS_THRESHOLD)) or
((attempts >= 5) and (pct < FAILURE_THRESHOLD)) then
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updateTrials: moving (', self.active[a].color,
') active -> blacklist');
{$ENDIF}
self.blacklist.append(self.active[a]); // time to give up on this one
self.active.deleteIndex(a);
end
else if ((matches >= 5) and (pct >= SUCCESS_THRESHOLD)) then
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updateTrials: moving (', self.active[a].color,
') active -> successful');
{$ENDIF}
self.successful.append(self.active[a]);
self.active.deleteIndex(a);
end;
end;
if (s >= 0) then
with self.successful[s] do
begin
inc(attempts);
if (success) then inc(matches);
if ((matches / attempts) < (SUCCESS_THRESHOLD - 0.1)) then
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updateTrials: moving (', self.successful[s].color,
') successful -> active');
{$ENDIF}
self.active.append(self.successful[s]);
self.successful.deleteIndex(s);
end;
end;
if (b >= 0) then
with self.blacklist[b] do
begin
inc(attempts);
if (success) then inc(matches);
end;
if (r >= 0) then
with self.runty[r] do
begin
inc(attempts);
if (success) then inc(matches);
end;
end;
// -----------------------------------------------------------------------------
// updatePointCount()
//
// Updates stats on a color
// -----------------------------------------------------------------------------
procedure Tcolorizer.updatePointCount(col: integer; points: integer;
objs: integer; msec: integer);
var
d, a, s, b, r: integer;
begin
d := self.discovered.returnInArray(col);
a := self.active.returnInArray(col);
s := self.successful.returnInArray(col);
b := self.blacklist.returnInArray(col);
r := self.runty.returnInArray(col);
if (d+a+s+b+r = -5) then
begin
writeln('Tcolorizer.updatePointCount: ERROR - Asked to update color, ',
col, ' - does not exist');
exit;
end
if (d >= 0) then
with self.discovered[d] do
begin
if (points > maxPoints) then maxPoints := points;
if (objs > maxObj) then maxObj := objs;
if (msec > queryTime) then queryTime := msec;
if (msec > BLACKLIST_THRESHOLD) then // move it to the blacklist
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updatePointCount: moving (', self.discovered[d].color,
') discovered -> blacklist');
{$ENDIF}
self.blacklist.append(self.discovered[d]);
self.discovered.deleteIndex(d);
end
else if (objs < 1) then // move it to the runty list
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updatePointCount: moving (', self.discovered[d].color,
') discovered -> runty');
{$ENDIF}
self.runty.append(self.discovered[d]);
self.discovered.deleteIndex(d);
end
else // since it is being used, move it to active
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updatePointCount: moving (', self.discovered[d].color,
') discovered -> active');
{$ENDIF}
self.active.append(self.discovered[d]);
self.discovered.deleteIndex(d);
end;
end;
if (a >= 0) then
with self.active[a] do
begin
if (points > maxPoints) then maxPoints := points;
if (objs > maxObj) then maxObj := objs;
if (msec > queryTime) then queryTime := msec;
if (msec > BLACKLIST_THRESHOLD) then // move it to the blacklist
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updatePointCount: moving (', self.active[a].color,
') active -> blacklist');
{$ENDIF}
self.blacklist.append(self.active[a]);
self.active.deleteIndex(a);
end
else if (objs < 1) then // move it to the runty list
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updatePointCount: moving (', self.active[a].color,
') active -> runty');
{$ENDIF}
self.runty.append(self.active[a]);
self.active.deleteIndex(a);
end;
end;
if (s >= 0) then
with self.successful[s] do
begin
if (points > maxPoints) then maxPoints := points;
if (objs > maxObj) then maxObj := objs;
if (msec > queryTime) then queryTime := msec;
if (msec > BLACKLIST_THRESHOLD) then // move it to the blacklist
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updatePointCount: moving (', self.successful[s].color,
') successful -> blacklist');
{$ENDIF}
self.blacklist.append(self.successful[s]);
self.successful.deleteIndex(s);
end
else if (objs < 1) then // move it to the runty list
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updatePointCount: moving (', self.successful[s].color,
') successful -> runty');
{$ENDIF}
self.runty.append(self.successful[s]);
self.successful.deleteIndex(s);
end;
end;
if (b >= 0) then
with self.blacklist[b] do
begin
writeln('Tcolorizer.updatePointCount: Warning - Updating blacklisted color (', col, ')');
if (points > maxPoints) then maxPoints := points;
if (objs > maxObj) then maxObj := objs;
if (msec > queryTime) then queryTime := msec;
end;
if (r >= 0) then
with self.runty[r] do
begin
writeln('Tcolorizer.updatePointCount: Warning - Updating runty color (', col, ')');
if (points > maxPoints) then maxPoints := points;
if (objs > maxObj) then maxObj := objs;
if (msec > queryTime) then queryTime := msec;
if (msec > BLACKLIST_THRESHOLD) then // move it to the blacklist
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updatePointCount: moving (', self.runty[r].color,
') runty -> blacklist');
{$ENDIF}
self.blacklist.append(self.runty[r]);
self.runty.deleteIndex(r);
end
else if (objs > 1) then // it started providing matches, move out of runty
begin
{$IFDEF DEBUG_ON}
writeln('***** Tcolorizer.updatePointCount: moving (', self.runty[r].color,
') runty -> active');
{$ENDIF}
self.active.append(self.runty[r]);
self.runty.deleteIndex(r);
end;
end;
end;
// -----------------------------------------------------------------------------
// delete()
//
// Delete info for a color
// -----------------------------------------------------------------------------
procedure Tcolorizer.delete(col: integer);
var
d, a, s, b, r: integer;
begin
d := self.discovered.returnInArray(col);
a := self.active.returnInArray(col);
s := self.successful.returnInArray(col);
b := self.blacklist.returnInArray(col);
r := self.runty.returnInArray(col);
if (d+a+s+b+r = -5) then
begin
writeln('Tcolorizer.delete: ERROR - Asked to delete color, ',
col, ' - does not exist');
exit;
end
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer.delete: deleting (', col, ')'); {$ENDIF}
if (d >= 0) then self.discovered.delete(col);
if (a >= 0) then self.active.delete(col);
if (s >= 0) then self.successful.delete(col);
if (b >= 0) then self.blacklist.delete(col);
if (r >= 0) then self.runty.delete(col);
end;
// -----------------------------------------------------------------------------
// cleanupColors()
//
// Weeds down the color list. Does not clean sucessful, blacklisted,
// or runty lists since these keep us from using bad colors or are the result
// of hard searching.
// -----------------------------------------------------------------------------
procedure Tcolorizer.cleanupColors();
var
i, t, cnt: integer;
found: boolean;
tmp: Tcolorizer;
begin
self.discovered.cleanupColors();
self.active.cleanupColors();
end;
// -----------------------------------------------------------------------------
// _gatherQ()
//
// Gathers a color by screen quadrants so we dont get so bogged
// down on background colors that take forever to collect. Hopefully
// don't have to break this into eights or make it recursive.
// -----------------------------------------------------------------------------
function Tcolorizer._gatherQ(var tpa: TPointArray; col: integer): boolean;
var
b: TBox;
c: TPoint;
quadrant: array[0..3] of TBox;
i: integer;
timer: TTimeMarker;
qtpa: TPointArray;
begin
b := mainscreen.getBounds();
c := mainscreen.getCenterPoint();
// NE, SE, SW, NW
quadrant[0] := IntToBox(c.x, b.y1, b.x2, c.y);
quadrant[1] := IntToBox(c.x, c.y, b.x2, b.y2);
quadrant[2] := IntToBox(b.x1, c.y, c.x, b.y2);
quadrant[3] := IntToBox(b.x1, b.y1, c.x, c.y);
setLength(tpa, 0);
timer.start();
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer._gatherQ: gathering colors for (', col, ')'); {$ENDIF}
for i := 0 to 3 do
begin
setLength(qtpa, 0);
if (findColorsTolerance(qtpa, col, quadrant[i], self.tol)) then
begin
if (timer.getTime() > (BLACKLIST_THRESHOLD div 4)) then
begin
// dump this color for something more productive
self.updatePointCount(col, length(qtpa)*4, 0, BLACKLIST_THRESHOLD+1);
result := false;
exit;
end
else
tpa.combine(qtpa);
end;
end;
if (length(tpa) > 0) then
result := true
else
result := false;
end;
// -----------------------------------------------------------------------------
// gather()
//
// Gathers a color into an atpa.
// -----------------------------------------------------------------------------
function Tcolorizer.gather(var atpa: T2DPointArray; c: integer): boolean;
var
tpa: TPointArray;
timer: TTimeMarker;
begin
setLength(tpa, 0);
result := true;
timer.start();
if (not self._gatherQ(tpa, c)) then
begin
result := false;
// no point in updating if it already got blacklisted
if (not self.blacklist.isInArray(c)) then
self.updatePointCount(c, 0, 0, timer.getTime());
exit;
end;
atpa := tpa.split(self.dist);
atpa.filterBetween(0, self.minPixels);
atpa.filterBetween(self.maxPixels, maxint);
atpa.sortBySize();
if (length(atpa) = 0) then
result := false;
self.updatePointCount(c, length(tpa), length(atpa), timer.getTime());
end;
// -----------------------------------------------------------------------------
// sample()
//
// Grabs a sampling of colors around the mouse area
// -----------------------------------------------------------------------------
procedure Tcolorizer.sample(n: integer = 3);
var
i, x, y: integer;
b: TBox;
colList: TIntegerArray;
begin
getMousePos(x,y);
b := [x, y, x, y];
b.expand(n);
if (b.x1 < 0) then b.x1 := 0;
if (b.x2 < 0) then b.x2 := 0;
if (b.y1 < 0) then b.y1 := 0;
if (b.y2 < 0) then b.y2 := 0;
colList := getColors(b.createTPA());
for i := 0 to high(colList) do
self.updateCount(colList[i], 1);
end;
// -----------------------------------------------------------------------------
// deepSample()
//
// Jiggles the mouse around a good spot to see if we can collect more colors
// -----------------------------------------------------------------------------
procedure Tcolorizer.deepSample(x: integer; y: integer; n: integer = 3);
var
p: TPoint;
i, t: integer;
matched: boolean;
s: string;
begin
p.create(x,y);
i := 5;
matched := true;
while (matched) do
begin
matched := false;
mouse(p.rand(i));
inc(i);
t := getSystemTime() + randomRange(uptextTimeout, uptextTimeout+80);
repeat
wait(20);
s := getMouseOverText();
if (pos(self.uptext, s) > 0) then
begin
matched := true;
self.sample(n);
end
else
if (s <> '') then // we got an uptext, but it isnt what we want
break;
until (matched or (getSystemTime() > t));
end;
end;
// -----------------------------------------------------------------------------
// untriedColors()
//
// Returns an array of colors we havent tried yet
// -----------------------------------------------------------------------------
function Tcolorizer.untriedColors() : TIntegerArray;
var
i, j: integer;
closeToBG, bgList: TIntegerArray;
begin
if (length(self.discovered) > CLEANUP_LOW_WATER) then
self.cleanupColors(); // might as well try to cut it down
self.discovered.sortByCount();
// put colors close to successful ones first in the list
for i := 0 to high(self.successful) do
for j := 0 to high(self.discovered) do
begin
if SimilarColors(self.successful[i].color, self.discovered[j].color, 10) then
begin
result.append(self.discovered[j].color);
break;
end;
end;
// find background colors (blacklisted with high queryTime). Put
// things close to the blacklist at the end.
setLength(bgList, 0);
for i := 0 to high(self.blacklist) do
begin
if self.blacklist[i].queryTime > BLACKLIST_THRESHOLD then
bgList.append(self.blacklist[i].color);
end;
setLength(closeToBG, 0);
for i := 0 to high(bgList) do
for j := 0 to high(self.discovered) do
begin
if (not result.isInArray(self.discovered[j].color)) and
SimilarColors(bgList[i], self.discovered[j].color, 10) then
begin
closeToBG.append(self.discovered[j].color);
break;
end;
end;
for i := 0 to high(self.discovered) do
if (not result.isInArray(self.discovered[i].color)) and
(not closeToBG.isInArray(self.discovered[i].color)) then
begin
result.append(self.discovered[i].color);
end;
result.combine(closeToBG);
end;
// -----------------------------------------------------------------------------
// activeColors()
//
// Returns an array of colors we need to test more
// -----------------------------------------------------------------------------
function Tcolorizer.activeColors() : TIntegerArray;
var
i: integer;
begin
if (length(self.active) > CLEANUP_LOW_WATER) then
self.cleanupColors(); // might as well try to cut it down
setLength(result, 0);
self.active.sortBySuccess();
for i := 0 to high(self.active) do
result.append(self.active[i].color);
end;
// -----------------------------------------------------------------------------
// successfulColors()
//
// Returns an array of colors we have confidence in
// -----------------------------------------------------------------------------
function Tcolorizer.successfulColors() : TIntegerArray;
var
i: integer;
begin
self.successful.sortBySuccess();
for i := 0 to high(self.successful) do
result.append(self.successful[i].color);
end;
// -----------------------------------------------------------------------------
// testCol()
//
// Sees if a color will get us to the desired mousetext
// -----------------------------------------------------------------------------
function Tcolorizer.testCol(c: integer; trials: integer = 1): boolean;
var
i, t, x, y: integer;
s: string;
atpa: T2DPointArray;
matched: boolean;
begin
result := false;
if (not self.gather(atpa, c)) then
begin
self.updateTrials(c, false);
exit;
end;
for i := 0 to high(atpa) do
begin
if (trials = 0) then
break
else
trials := trials - 1;;
atpa[i].getBounds().mouse();
matched := false;
t := getSystemTime() + randomRange(uptextTimeout, uptextTimeout+80);
repeat
wait(20);
s := getMouseOverText();
if (pos(self.uptext, s) > 0) then
matched := true
else
if (s <> '') then // we got an uptext, but it isnt what we want
break;
until (matched or (getSystemTime() > t));
if (matched) then
begin
getMousePos(x,y);
case random(10) of
3,4: self.deepSample(x,y);
end;
self.updateTrials(c, true);
result := true;
end
else
self.updateTrials(c, false);
end;
end;
// -----------------------------------------------------------------------------
// colorize()
//
// Tests new and in progress colors to try to find new ones that are successful.
// -----------------------------------------------------------------------------
function Tcolorizer.colorize(maxTime: integer = 120000; enough: integer = 5): boolean;
var
i, timeout: integer;
tia: TIntegerArray;
begin
if (length(self.successful) >= enough) then exit;
timeout := getSystemTime() + maxTime;
result := false;
while (getSystemTime() < timeout) do
begin
while ((length(self.active) < 8) and (length(self.discovered) > 0)) do
begin
tia := self.untriedColors();
if (length(tia) < 1) then exit;
self.testCol(tia[0], 1);
end;
tia := self.activeColors();
if (length(tia) < 1) then exit;
for i := 0 to min(high(tia), 4) do
begin
self.testCol(tia[i], 2);
end;
if (length(self.successful) >= enough) then
begin
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer.colorize: REACHED SUCCESS!!!'); {$ENDIF}
result := true;
exit;
end;
end;
end;
// -----------------------------------------------------------------------------
// detectObj()
//
// Detect an object in a box.
// -----------------------------------------------------------------------------
function Tcolorizer.detectObj(var x: integer; var y: integer; var menuText: string;
b: TBox; mouseButton: integer = MOUSE_MOVE): boolean;
var
i, j: integer;
s: string;
opts: TOptionArray;
t: integer;
p: TPoint;
matched: boolean;
begin
x := 0;
y := 0;
menuText := '';
result := false;
matched := false;
if (mouseButton = MOUSE_NONE) or (mouseButton = MOUSE_MIDDLE) then exit;
t := getSystemTime() + randomRange(uptextTimeout, uptextTimeout+80);
repeat
b.mouse();
wait(20);
s := getMouseOverText();
if (pos(self.uptext, s) > 0) then
begin
menuText := s;
matched := true;
result := true;
end
else
if (s <> '') then break; // we got an uptext, but it isnt what we want
until (matched or (getSystemTime() > t));
if (matched) then
begin
self.sample();
getMousePos(x,y); // save this for a sec
case (mouseButton) of
MOUSE_LEFT:
begin
fastClick(MOUSE_LEFT);
exit;
end;
MOUSE_RIGHT, MOUSE_MOVE:
begin
fastClick(MOUSE_RIGHT);
if (mouseButton = MOUSE_RIGHT) then
begin
result := chooseoption.select([self.uptext], 100);
exit;
end
opts := chooseOption.getOptions();
chooseOption.close();
for j := 0 to high(opts) do
begin
if (pos(self.uptext, opts[j].str) > 0) then
begin
menuText := opts[j].str;
break;
end;
end;
mouse(point(x,y), MOUSE_MOVE);
end;
end;
end;
end;
// -----------------------------------------------------------------------------
// examineGrid()
//
// Try to detect an object in one of the boxes in grid.
// -----------------------------------------------------------------------------
function Tcolorizer.examineGrid(grid: TBoxArray): string;
var
i, j, x, y, t: integer;
s: string;
opts: TOptionArray;
p: TPoint;
matched: boolean;
begin
result := '';
while (length(grid) > 0) do
begin
i := randomRange(0, length(grid));
if self.detectObj(x, y, s, grid[i]) then
begin
result := s;
break;
end;
grid.deleteIndex(i);
end;
if (result <> '') then
case random(10) of
3,4: self.deepSample(x,y);
end;
end;
// -----------------------------------------------------------------------------
// motionDetect()
//
// Finds objects based on screen movement (pixel shift).
// -----------------------------------------------------------------------------
function Tcolorizer.motionDetect(): string;
var
i, j, t: integer;
grid, targetGrid, tried: TBoxArray;
pixels: TIntegerArray;
max, pct: integer;
begin
result := '';
setLength(tried, 0);
grid := mainscreen.getBounds().split(GRIDSIZE, GRIDSIZE);
for t := 15 to 95 with 20 do
begin
if (t > 70) then // we're not doing very good, lets try some
setLength(tried, 0); // of the boxes we tried earlier
pixels := grid.pixelShift(PIXELSHIFT_WAIT);
max := pixels.max();
setLength(targetGrid, 0);
for i := 0 to high(grid) do
begin
if (tried.isInArray(grid[i])) then // dont keep moving the mouse to the
continue; // same place... try new ones
pct := trunc( ((pixels[i]/max) * 100.0 ));
if ((pct + t) > 100) then
begin
setLength(targetGrid, length(targetGrid)+1);
targetGrid[high(targetGrid)] := grid[i];
end;
end;
result := self.examineGrid(targetGrid);
if (result = '') then
begin
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer.motionDetect: FAILED TO IDENTIFY ANYTHING. tol=', t); {$ENDIF}
end
else
begin
{$IFDEF DEBUG_ON} writeln('***** Tcolorizer.motionDetect: Identified - ', result); {$ENDIF}
exit;
end;
tried.combine(targetGrid);
end;
end;
///////////////////////////////////////////////////////////////////////////
/////////// TEST PROGRAM
///////////
///////////////////////////////////////////////////////////////////////////
var
colorTest: Tcolorizer;
i, t: integer;
name: string;
begin
smartPlugins := ['d3d9.dll'];
smartEnableDrawing := true;
ClearDebug();
SetupSRL();
colorTest.init('Unknown', 'Attack', 150 {uptext timeout}, 3 {tol},
5 {dist}, 5 {min}, 1000 {max});
t := getSystemTime();
name := colorTest.motionDetect();
if (name <> '') and (name <> 'Attack') then
begin
writeln('took ', getSystemTime() - t, ' to detect ', name);
colorTest.name := name;
colorTest.load();
writeln(colorTest);
for i := 1 to ( length(colorTest.successful) + 5 ) do
begin
t := getSystemTime();
colorTest.colorize(60000, i);
writeln('took ', getSystemTime() - t, ' to identify good color # ', i);
end;
writeln(colorTest);
colorTest.save();
end;
end.