program New; type BlackList = array of integer; type BlackListNet = array of Tpoint; type Letter=record WhichLetter: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 2)=0) or ((hy mod 2)=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; procedure LoadLetters; begin setarraylength(Letters,26); Letters[0].WhichLetter:='A'; Letters[0].List:=LoadBlackListFromString('0 1 2 3 4 5 6 10 11 15 17 19 20 21 22 23 24 25 26 27 30 31 33'); Letters[1].WhichLetter:='B'; Letters[1].List:= LoadBlackListFromString('0 1 2 3 7 8 22 23 24 25 30 31 32 33 35'); Letters[2].WhichLetter:='C'; Letters[2].List:= LoadBlackListFromString('0 1'); Letters[3].WhichLetter:='D'; Letters[3].List:= LoadBlackListFromString('0 1 29 32 33 34 35'); Letters[4].WhichLetter:='E'; Letters[4].List:=LoadBlackListFromString('0 1 2 3 4 5 6 7 8 9 10 11 12 13 23 24'); Letters[5].WhichLetter:='F'; Letters[5].List:= LoadBlackListFromString('0 1'); Letters[6].WhichLetter:='G'; Letters[6].List:= LoadBlackListFromString('0 1 13 24 25 33 35'); Letters[7].WhichLetter:='H'; Letters[7].List:= LoadBlackListFromString('0 1 7 8 23 24 32 33 34 35'); Letters[8].WhichLetter:='I'; Letters[8].List:= LoadBlackListFromString('14 15 16 17 18 19');; Letters[9].WhichLetter:='J'; Letters[9].List:= LoadBlackListFromString('0 1'); Letters[10].WhichLetter:='K'; Letters[10].List:= LoadBlackListFromString('0 1'); Letters[11].WhichLetter:='L'; Letters[11].List:=LoadBlackListFromString('0 1 2 3 4 5 6 7 8 9 10 11 12 13'); Letters[12].WhichLetter:='M'; Letters[12].List:= LoadBlackListFromString('0 2 3 7 8 9 10 11 12 13 19 21 22 23 24 25 26 30'); Letters[13].WhichLetter:='N'; Letters[13].List:=LoadBlackListFromString('0 1 4 5 14 16 19 25 26 27 28 29 32 34 35'); Letters[14].WhichLetter:='O'; Letters[14].List:= LoadBlackListFromString('32 33 34 35'); Letters[15].WhichLetter:='P'; Letters[15].List:=LoadBlackListFromString('0 1 2 3 8 9 24 25 30 32 34'); Letters[16].WhichLetter:='Q'; Letters[16].List:= LoadBlackListFromString('0 1'); Letters[17].WhichLetter:='R'; Letters[17].List:=LoadBlackListFromString('0 1 2 3 8 9 23 24 25 26 27 30 31 32 33 34'); Letters[18].WhichLetter:='S'; Letters[18].List:= LoadBlackListFromString('0 2 4 5 6 7 8 14 24 25 26 29 31 33'); Letters[19].WhichLetter:='T'; Letters[19].List:=LoadBlackListFromString('14 15 16 17 18 19'); Letters[20].WhichLetter:='U'; Letters[20].List:= LoadBlackListFromString('0 1 13 29 32 33 34 35'); Letters[21].WhichLetter:='V'; Letters[21].List:= LoadBlackListFromString('0 1'); Letters[22].WhichLetter:='W'; Letters[22].List:= LoadBlackListFromString('3 4 5 6 7 8 9 10 11 14 18 20 21 22 23 24 25 26 27 28 29 31'); Letters[23].WhichLetter:='X'; Letters[23].List:= LoadBlackListFromString('0 1'); Letters[24].WhichLetter:='Y'; Letters[24].List:=LoadBlackListFromString('2 4 5 6 7 8 14 15 17 18 19 20 21 22 23'); Letters[25].WhichLetter:='Z'; Letters[25].List:= LoadBlackListFromString('0 1'); end; var MyNet:BlackListNet; tmpList,tmpList2:BlackList; tmpstr:string; done:boolean; i,i2:integer; begin MyNet:= CreateChickenNet; LoadLetters; for i:=0 to 6 do begin tmpList:=CreateLetterList(i,MyNet); writeln(inttostr(i)); WriteBlackList(tmpList); {i2:=0; done:=false; repeat if CompareBlackLists(tmpList,Letters[i2].List) then begin writeln('Chicken'+inttostr(i)+' has letter '+Letters[i2].WhichLetter); done:=true; end; i2:=i2+1; until ((i2=26)or (done)); } end; {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.