program New;
{.include SRL/SRL.scar}
type
BlackList = array of integer;
type
BlackListNet = array of Tpoint;
{*******************************************************************************
function CreateTightNet : BlackListNet;
By: Boreas
Note: Purely an internal function, used in setup.
Description: Same as above but takes a little (not noticeable) longer and is
more accurate. 38% of the slot. 74% of slot without amount
*******************************************************************************}
function CreateTightNet :BlackListNet;
var Counter,hx,hy:integer;
var TPointsToCheck:array [0..367] of TPoint;
begin
repeat
hy:=15;
hx:=hx+1;
repeat
hy:=hy+1;
if (((hx mod 2)=0) or ((hy mod 2)=0)) then
begin
TPointsToCheck[Counter].x:=hx;
TPointsToCheck[Counter].y:=hy;
Counter:=Counter+1;
end;
until hy=31;
until hx=31;
result:=TPointsToCheck;
end;
{*******************************************************************************
function CreateItemBlackList(WhichBankSlot:integer;WhichNet:BlackListNet):BlackList;
By: Boreas
Description: Looks at the points in the list for an item, and returns an array
contatining the indexes of the points that are black.
Usage: WhichBankSlot-just what it sounds like. WhichList-the TPointArray
containing positions relative to the x1,y1 of a bankslot which you want to check
*******************************************************************************}
function CreateItemBlackList(WhichBankSlot:integer;WhichNet:BlackListNet):BlackList;
var Counter,Counter2,Tmpx1,Tmpy1,ListLength:integer;
var TmpArray:array of integer;
begin
Tmpx1:=79+((((WhichBankSlot+7)mod 8))*47);
Tmpy1:=62+((((WhichBankSlot-1)/8))*38);
ListLength:=getarraylength(WhichNet)-1;
setarraylength(tmparray,1);
for Counter:= 0 to ListLength do
begin
if GetColor(Tmpx1+WhichNet[Counter].x,Tmpy1+WhichNet[Counter].y)=65536 then
begin
TmpArray[Counter2]:=Counter;
Counter2:=Counter2+1;
setarraylength(TmpArray,Counter2+1);
end;
end;
setarraylength(tmpArray,Counter2);
result:=TmpArray;
end;
{*******************************************************************************
function GetNameOfItemInBank: string;
By: Boreas, bases off of Ron's Replace
Description: Takes item name from uptext in bankscreen, and changes spaces
to underscores
*******************************************************************************}
function GetNameOfItemInBank: string;
var
a : LongInt;
TheString:string;
begin
TheString:=GetUptext;
a := Pos('Withdraw 1 ', TheString);
if(a = 0)then
begin
// Do nothing..
end else
begin
Delete(TheString, a, Length('Withdraw 1 '));
Insert('', TheString, a);
a := Pos(' /', TheString);
delete(thestring,a,Length(TheString));
repeat
a := Pos(' ', TheString);
if a<>0 then
begin
Delete(TheString, a, 1);
Insert('_', TheString, a);
end;
until a=0;
Result := TheString;
end;
end;
{*******************************************************************************
procedure WriteBlackList(TheBlackList: BlackList);
By: Boreas/moparisthebest
Description: Displays a BlackList as a string in debug box. Basically
array of integer -> string and DTM editor's DTM to Text put together
*******************************************************************************}
procedure WriteBlackList(TheBlackList: BlackList);
var
i, arrayLength: Integer;
mystr,tmpstr,tmpresult:string;
begin
arrayLength := GetArrayLength(TheBlackList);
repeat
tmpresult := tmpresult + IntToStr(TheBlackList[i]);
if (not (i = (arrayLength - 1))) then
tmpresult := tmpresult + ' ';
i := i + 1;
until (i = arrayLength)
mystr:=GetNameOfItemInBank;
if mystr='' then mystr:='BlackList';
tmpresult:=' BL_'+mystr+' := LoadBlackListFromString('+chr(39)+tmpresult+chr(39)+');';
writeln(tmpresult);
end;
var MyNet:BlackListNet;
MyList:Blacklist;
slot1:integer;
begin
SetupSRL;
MyNet:=CreateTightNet;
writeln('Put mouse over item and press f12');
repeat
repeat
wait(30);
until ((isfkeydown(12)) or (isfkeydown(11)));
if not(isfkeydown(11)) then
begin
getmousepos(x,y);
slot1:=(((((y-62) div 38)+1)-1)*8)+(((x-79) div 47)+1);
MyList:=CreateItemBlackList(slot1,MyNet);
WriteBlackList(Mylist);
writeln('Press F12 to do another one');
writeln('Press F11 to end');
end;
until isfkeydown(11);
end.