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.