All pastes #619689 Raw Edit

Untitled

public text v1 · immutable
·published 2007-07-14 23:05 UTC
rendered paste body
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.