SCAR Code:
program New;
type BmpCom=record
bmp,inc,w,h,NumberOfColors:integer;
ColorArray:array of tpoint;
SkipArray:array of integer;
end;
var tmpres,tx,ty:integer;
var inccounter,iter,iter2,NumberOfCombos,NumberOfBmps,x,y,parray,tmpcolor,tmpal:integer;
Bmps:array of BmpCom;
Combos:array of array of integer;
AnswerArray,AnswerArray2:array of tpoint;
procedure DeclareBmps;
begin
NumberOfBmps:=4;
setarraylength(bmps,NumberofBmps);
bmps[0].bmp:=loadbitmap(apppath+'/duke4.bmp');
bmps[1].bmp:=loadbitmap(apppath+'/duke5.bmp');
bmps[2].bmp:=loadbitmap(apppath+'/duke6.bmp');
bmps[3].bmp:=loadbitmap(apppath+'/duke7.bmp');
end;
{*******************************************************************************
function InIntArray(TheInt:integer;TheArray:array of integer):boolean;
By: Boreas
Description: Returns true if TheInt is a member of TheArray
******************************************************************************}
function InIntArray(TheInt:integer;TheArray:array of integer):boolean;
var i:integer;
begin
if getarraylength(thearray)<>0 then
repeat
if TheArray[i]=TheInt then
result:=true;
i:=i+1;
until ((i=getarraylength(TheArray)) or (result));
end;
function CountColorbmp(thebmp,color,x1,y1,x2,y2:integer):integer;
var x,y,tmpres:integer;
begin
tmpres:=0;
for x:=x1 to x2 do
begin
for y:=y2 to y2 do
begin
if FastGetPixel(thebmp,x,y)=color then tmpres:=tmpres+1;
writeln(inttostr(x)+' '+inttostr(y)+' '+inttostr(FastGetPixel(thebmp,x,y))+' '+inttostr(tmpres));
end;
end;
result:=tmpres;
end;
function LowestTolSimColors(TheArray:array of integer):integer;
var parray:integer;
begin
for parray:=0 to getarraylength(TheArray)-2 do
begin
repeat
result:=result+1;
until SimilarColors(TheArray[parray],TheArray[parray+1],result);
end;
end;
function RearrangeTPA(thearray:array of tpoint; startpt, endpt:integer; dox,up:boolean):array of tpoint;
var
temp, pArray : integer;
done : boolean;
ttp:tpoint;
tmpTPA : array of tpoint;
begin
setarraylength(tmpTPA,getarraylength(thearray));
tmpTPA:=thearray;
setarraylength(result,endpt+1-startpt);
if not(up) then
begin
if dox then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].x < tmpTPA[pArray + 1].x) then
begin
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
if not(dox) then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].y < tmpTPA[pArray + 1].y) then
begin
ttp := thearray[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
end;
if up then
begin
if dox then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].x > tmpTPA[pArray + 1].x) then
begin
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
if not(dox) then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].y > tmpTPA[pArray + 1].y) then
begin
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
end;
pArray:=startpt-1;
for temp:=0 to getarraylength(result)-1 do
begin
pArray:=pArray+1;
result[temp]:=tmpTPA[pArray];
end;
end;
function RemoveDupsFromTPASingle(var StartTPA: array of Tpoint; DoX:boolean): array of Tpoint;
var
ArrayLength, pFindDups, pBubbleUp: integer;
tpSwap:tpoint;
begin
ArrayLength:=getarraylength(StartTPA);
// result:=RearrangeTPA(StartTPA,0,ArrayLength-1,true,true);
if DoX then
begin
result:=RearrangeTPA(StartTPA,0,ArrayLength-1,true,true);
//for pFindDups := 0 to (ArrayLength - 2) do
// begin
pFindDups:=0; //
repeat //
if(result[pFindDups].x = result[pFindDups + 1].x) then
begin
for pBubbleUp := pFindDups to (ArrayLength-2) do
begin
tpSwap := result[pBubbleUp];
result[pBubbleUp] := result[pBubbleUp+1];
result[pBubbleUp+1] := tpSwap;
end;
ArrayLength := ArrayLength-1;
setarraylength(result, ArrayLength);
pFindDups:=pFindDups-1;
end;
pFindDups:=pFindDups+1; //
until pFindDups>(ArrayLength - 2);//
//end;
end;
if not DoX then
begin
result:=RearrangeTPA(StartTPA,0,ArrayLength-1,false,true);
for pFindDups := 0 to (ArrayLength - 2) do
begin
if(result[pFindDups].y = result[pFindDups + 1].y) then
begin
for pBubbleUp := pFindDups to (ArrayLength-2) do
begin
tpSwap := result[pBubbleUp];
result[pBubbleUp] := result[pBubbleUp+1];
result[pBubbleUp+1] := tpSwap;
end;
ArrayLength := ArrayLength-1;
setarraylength(result, ArrayLength);
end;
end;
end;
end;
begin {
bmp1:= BitmapFromString(32, 57, 'z78DAED99DB72EB2A0C865' +
'F090771BA1402DEFF9116415CC8439D8D9BFAB0672CCFFCED3869' +
'FC490849A44A3DF6D8638F3DF6D863FF6DA42285D4952844C57A8' +
'E610829D057FC89306AD6E49325907A0EFF375E9023C0906CD2B4' +
'B0F29DA3E336F2FFEE33A1807A9141F05AB3F29DA3C9FFCA0B932' +
'06A6315646DBB171AF42B9F43BEC53FF3AC1492232B35630E59B1' +
'FED5FA7EC3FFF989A9A44479A5949022658A1122C510DCD1E433F' +
'CE3D36585E1DDDAB510452BF568F2BD5E041BB47369A11C512AFA' +
'9AFA2644678DEB9AEBCF741F7E266725248725A22F3660F4DA2AB' +
'4AE98CCEAB34D46CD54D10BE24F35A989969850317FD7C57B0B98' +
'BCB1F5B58801AF9A073EF33BAA4BF08A1A8BCF4CDB994B78D9C81' +
'A7C30CEDF8D9C150054BD9A86E2D02006BF9852B36AA975DF41AD' +
'FD67E6FC0CB95526D40B0DD4CB9B57BD9ADA978906A5CA5721830' +
'7772D7F8D682D902619572F0508684C9D0E0A7B24B593B7F733B9' +
'D4ABBCE8E44D21BEC3CFFA03F90DF8472F985C678D1A7BFC59D92' +
'FCE28A17DA2139EB25E558B98B353B54872FE8CE4929F7DBC0F3F' +
'33FC10FF416FC7CFD166E5BD2CB3BD716EFE2DEF856BF9999333A' +
'47931BF37A5EF67324BB69E3FAD2B8D3593EF4F45A0E949CC1B79' +
'BE229FAE8DC7F18F99C019DB09DB84207300169D74EA2B7229FF2' +
'AC21FBB2A33775AFEBDA9F3F5D40B33FCDDEB3FE2EF35442A4F32' +
'0379EFAD1C6D31B3D50680EF09ED3DB37DAE3F2B2FDA4E89BE1ED' +
'87E3997F227ACA6AF0DE6919FD53B5B3B019FAD78DA9FE7EF9D1D' +
'5C3629285BF6ACC5D83767C847FEAEC30ACE93B0EF7EB11ABCAB7' +
'B4BE729F2893C3987FF97FB94BBCF50037793CB5E7C706F5A4569' +
'A386EF203F9D5F4E5F9BFCC3E9A99FA1467239F3C813D644FF3D9' +
'07F7E15FE87FCAB33EFA04793B38DF1DC9DF3929CA78813A7FAAF' +
'AACDA0D79E6A7F58918DDC58A99891EE709EDA8CFFB843B9F60E9' +
'39EBAD436F9376AFB5567A8D15C3465FDBD8DD43E9F785777E999' +
'13C20EFE36B18FCCD278AAA425C0FBFBEFEBB365C5DFE6760A01D' +
'DC2FAF93DEA66E6EAEC0F8BFCFFC856FC59D5638F3DF6D84EFB07' +
'C14271C3'); }
DeclareBmps;
for iter:=0 to NumberofBmps-1 do
begin
GetBitmapSize(bmps[iter].bmp,bmps[iter].w,bmps[iter].h);
for x:=0 to bmps[iter].w-1 do
begin
for y:=0 to bmps[iter].h-1 do
begin
tmpcolor:=fastgetpixel(bmps[iter].bmp,x,y);
if not( InIntArray(tmpcolor,bmps[iter].SkipArray)) and (tmpcolor<>0) then
begin
tmpAL:= GetArrayLength(bmps[iter].SkipArray);
SetArrayLength(bmps[iter].SkipArray,tmpAL+1);
SetArrayLength(bmps[iter].ColorArray,tmpAL+1);
bmps[iter].SkipArray[tmpAL]:=tmpcolor;
bmps[iter].ColorArray[tmpAL].x:=tmpcolor;
tmpres:=0;
for tx:=0 to bmps[iter].w-1 do
begin
for ty:=0 to bmps[iter].h-1 do
begin
if FastGetPixel(bmps[iter].bmp,tx,ty)=tmpcolor then tmpres:=tmpres+1;
end;
end;
bmps[iter].ColorArray[tmpAL].y:= tmpres;
//bmps[iter].ColorArray[tmpAL].y:=CountColorbmp(bmps[iter].bmp,tmpcolor,0,0,31,56);
//bmps[iter].ColorArray[tmpAL].y:= CountColor(tmpcolor,0,0,31,56);
end;
end;
end;
//writeln(inttostr(iter)+' bitmap');
//for parray:=0 to getarraylength(bmps[iter].colorArray)-1 do
//begin
//writeln(inttostr(bmps[iter].colorarray[parray].x)+' '+inttostr(bmps[iter].colorarray[parray].y));
//end;
RearrangeTPA(bmps[iter].colorarray,0,getarraylength(bmps[iter].colorarray)-1,false,false);
// for parray:=0 to getarraylength(bmps[iter].colorArray)-1 do
// begin
// writeln(inttostr(bmps[iter].colorarray[parray].x)+' '+inttostr(bmps[iter].colorarray[parray].y));
// end;
parray:=0;
repeat
if bmps[iter].colorarray[parray].y < (round(bmps[iter].w*bmps[iter].h/100)) then
break;
parray:=parray+1;
until parray=getarraylength(bmps[iter].colorarray);
setarraylength(bmps[iter].colorarray,parray);
// for parray:=0 to getarraylength(bmps[iter].colorArray)-1 do
// begin
/// writeln(inttostr(bmps[iter].colorarray[parray].x)+' '+inttostr(bmps[iter].colorarray[parray].y));
// end;
bmps[iter].NumberOfColors:=getarraylength(bmps[iter].colorarray);
freebitmap(bmps[iter].bmp);
end;
bmps[0].inc:=1;
inccounter:=1;
for iter:=1 to numberofbmps-1 do
begin
inccounter:=inccounter*bmps[iter-1].numberofcolors;
bmps[iter].inc:=inccounter;
end;
NumberOfCombos:=1;
for iter:=0 to numberofbmps-1 do
begin
writeln('bmp '+inttostr(iter)+' NUM COLS '+inttostr(bmps[iter].Numberofcolors));
NumberOfCombos:=NumberOfCombos*bmps[iter].Numberofcolors;
//writeln(
end;
writeln('numofcombos '+inttostr(NumberofCombos));
setarraylength(combos,NumberofCOmbos);
for iter:=0 to NumberofCOmbos-1 do
begin
// if ( iter mod 10000) = 0 then
// begin
// cleardebug;
// writeln(inttostr(iter)); end;
setarraylength(combos[iter],numberofbmps);
for iter2:=0 to numberofbmps-1 do
begin
// writeln(inttostr(iter)+' '+inttostr(iter2)+inttostr(((iter/bmps[iter2].inc) mod bmps[iter2].numberofcolors)));
Combos[iter][iter2]:=bmps[iter2].colorarray[((iter/bmps[iter2].inc) mod bmps[iter2].numberofcolors)].x;
end;
end;
//writeln(inttostr(NumberofCOmbos))
//for iter:=0 to NumberofCOmbos-1 do
//writeln(inttostr(iter)+' '+inttostr(combos[iter][0])+' '+inttostr(combos[iter][1])+' '+inttostr(combos[iter][2]));
setarraylength(AnswerArray,NumberOfCombos);
//for iter:=0 to NumberofCOmbos-1 do
//begin
iter:=0;
iter2:=0;
setarraylength(AnswerArray2,1);
AnswerArray2[0].x:=getarraylength(Combos);
repeat
// if ( iter mod 10000) = 0 then
// begin
// cleardebug;
// writeln(inttostr(iter)); end;
AnswerArray[iter].x:=Combos[iter2][0];
AnswerArray[iter].y:=LowestTolSimColors(Combos[iter2]);
if AnswerArray[iter].y > 100 then
begin
iter:=iter-1;
numberofcombos:=numberofcombos-1;
setarraylength(answerarray, numberofcombos);
end;
iter:=iter+1;
iter2:=iter2+1;
until ((iter>=(NumberOfCombos-2)) or (iter2 >= AnswerArray2[0].x-2)) ;
numberofcombos:=numberofcombos-2;
setarraylength(answerarray, numberofcombos);
//end;
//RearrangeTPA(AnswerArray,0,getarraylength(AnswerArray)-1,true,false);
//AnswerArray2:=RemoveDupsFromTPASingle(AnswerArray,true);
//AnswerArray2:=AnswerArray;
RearrangeTPA(AnswerArray,0,getarraylength(AnswerArray)-1,false,false);
for iter:=0 to getarraylength(AnswerArray)-1 do
begin
writeln(inttostr(AnswerArray[iter].x)+' '+inttostr(AnswerArray[iter].y));
end;
end.