All pastes #430484 Raw Edit

Someone

public text v1 · immutable
·published 2007-04-09 00:42 UTC
rendered paste body
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.