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.