All pastes #619635 Raw Edit

Untitled

public text v1 · immutable
·published 2007-07-14 22:21 UTC
rendered paste body
program New;


type
  BlackList = array of integer;

type
  BlackListNet = array of Tpoint;
                               {
type Letter=record
WhichLeter:string;
List:BlackList;
end;
var Letters:array of Letter;  }

function CreateChickenNet :BlackListNet;
var Counter,hx,hy,AL:integer;
  var TPointsToCheck:array of TPoint;
begin
  hx:=5
  repeat
    hy:=5;
    hx:=hx+1;
    repeat
      hy:=hy+1;
      if (((hx mod 4)=0) or ((hy mod 4)=0)) then
      begin
      AL:=AL+1;
      setarraylength(TPointsToCheck,AL);
        TPointsToCheck[Counter].x:=hx;
        TPointsToCheck[Counter].y:=hy;
        Counter:=Counter+1;
      end;
    until hy=15;
  until hx=15;
  result:=TPointsToCheck;
end;

function CreateLetterList(Chicken:integer;WhichNet:BlackListNet):BlackList;
var Counter,Counter2,Tmpx1,Tmpy1,ListLength:integer;
var TmpArray:array of integer;
begin
  case Chicken of
  0:tmpx1:=151-8;
  1:tmpx1:=204-8;
  2:tmpx1:=259-8;
  3:tmpx1:=313-8;
  4:tmpx1:=366-8;
  5:tmpx1:=421-8;
  6:tmpx1:=475-8;
 end;


  // Tmpx1:=143+(Chicken*(401-348));
    Tmpy1:=214;  ////////////
  ListLength:=getarraylength(WhichNet)-1;
  setarraylength(tmparray,1);
  for Counter:= 0 to ListLength do
  begin

    if GetColor(Tmpx1+WhichNet[Counter].x,Tmpy1+WhichNet[Counter].y)=6248 then
    begin
      TmpArray[Counter2]:=Counter;
      Counter2:=Counter2+1;
      setarraylength(TmpArray,Counter2+1);

    end;
  end;
  setarraylength(tmpArray,Counter2);
  result:=TmpArray;
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;
  tmpresult:string;
begin
  arrayLength := GetArrayLength(TheBlackList);
  //writeln(inttostr(arrayLength));
  repeat
    tmpresult := tmpresult + IntToStr(TheBlackList[i]);
    if (not (i = (arrayLength - 1))) then
      tmpresult := tmpresult + ' ';
    i := i + 1;
  until (i = arrayLength)
  tmpresult:='BlackList := LoadBlackListFromString('+chr(39)+tmpresult+chr(39)+');';
  writeln(tmpresult);
end;

{*******************************************************************************
function LoadBlackListFromString(BlackListString: string): BlackList;
By: Boreas/moparisthebest
Description: Loads a BlackList from a string given by WriteBlackList. Basically
string -> array or integer
*******************************************************************************}
function LoadBlackListFromString(BlackListString: string): BlackList;
var
  i, spacePos: Integer;
begin
  repeat
    SetArrayLength(Result, i + 1);
    spacePos := Pos(' ', BlackListString);
    if (not (spacePos = 0)) then
    begin
      Result[i] := StrToInt(Copy(BlackListString, 1, spacePos - 1));
    end
    else
    begin
      Result[i] := StrToInt(Copy(BlackListString, 1, Length(BlackListString)));
      break;
    end;
    Delete(BlackListString, 1, spacePos);
    i := i + 1;
  until (False)
end;

{*******************************************************************************
function CompareBlackLists(FirstBlackList,SecondBlackList:BlackList):boolean;
By: Boreas
Description: Returns true both BlackLists are the same
******************************************************************************}
function CompareBlackLists(FirstBlackList,SecondBlackList:BlackList):boolean;
var Counter:integer;
begin
  if not(getarraylength(FirstBlackList)=getarraylength(SecondBlackList)) then
    result:=false;


  if (getarraylength(FirstBlackList)=getarraylength(SecondBlackList)) then
  begin
    result:=true;
    repeat
      if not(FirstBlackList[Counter]=SecondBlackList[Counter]) then
        result:=false;
      Counter:=Counter+1;
    until ((Counter=getarraylength(FirstBlackList)) or (result=false));
  end;
end;


var MyNet:BlackListNet;
tmpList,tmpList2:BlackList;
tmpstr:string;
begin
MyNet:= CreateChickenNet;
tmpList:=CreateLetterList(0,MyNet);
WriteBlackList(tmpList);

repeat
wait(30);
until isfkeydown(12);

tmpstr:= Readln('Which Chicken is the letter that was in the previous Chicken0 in?');
tmpList2:=CreateLetterList(strtoint(tmpstr),MyNet);
WriteBlackList(tmpList2);
if CompareBlackLists(tmpList,tmpList2) then writeln('yes');
writeln('done');

end.