Was able to get it down to about 4:50 (290 seconds); temporarily fixed the color type issue in the settings screen.
Code:
// SetHSV() and GetColor() based on a
// c++ program from :
// http://commons.wikimedia.org/wiki/File:Color_complex_plot.jpg
// by Claudio Rocchini
// http://en.wikipedia.org/wiki/Domain_coloring
//Global variables
initComp:=0;
r; //r is size of initial square which is 2^r by 2^r pixels
c;
coloring;
REGridOn;
IMGridOn;
em1:=1/(e-1);
SetHSV(h,s,v);
GetColor(v);
EvalF();
gComp_setdefault();
gComp_getsettings();
PlotSetup()
begin
if initComp==0 then
gComp_setdefault();
end;
gComp_getsettings();
end;
gComp_setdefault()
BEGIN
Xmin:=-4; Xmax:=4;
Ymin:=-3; Ymax:=3;
r:=4;
c:=.01;
coloring:=1;
initComp:=1;
REGridOn:=1;
IMGridOn:=1;
end;
view "Set Plot Options",gComp_getsettings()
begin
local j;
if initComp==0 then
gComp_setdefault();
end;
local xmintemp:=Xmin,xmaxtemp:=Xmax;
local ymintemp:=Ymin,ymaxtemp:=Ymax;
local coloringtemp:=coloring;
local rtemp:=r,ctemp:=c,REGridOntemp:=REGridOn,IMGridOntemp:=IMGridOn;
if input(
{
{xmintemp,[0],{15,30,0}},
{xmaxtemp,[0],{65,30,0}},
{ymintemp,[0],{15,30,1}},
{ymaxtemp,[0],{65,30,1}},
{rtemp,[0],{15,20,2}},
{ctemp,[0],{65,30,2}},
{REGridOntemp,0,{90,10,4}},
{IMGridOntemp,0,{90,10,5}},
{coloringtemp,{"Red-Yellow Domain Coloring","HSV Domain Coloring", "Logarithmic"},{20,30,3}}
},
"Plot Setup",
{
"Xmin=", "Xmax=",
"Ymin=", "Ymax=",
"Box=", "Resolution=",
"RE Contour Grid",
"IM Contour Grid",
"Coloring"
},
{
"Enter minimum horizontal value",
"Enter maximum horizontal value",
"Enter minimum vertical value",
"Enter maximum vertical value",
"Initial pixel square width. Enter 0 for one pass",
"Resolution for contour grid & magnitude mask",
"Draw Real Contour Grids",
"Draw Imaginary Contour Grids",
"Select coloring scheme"
})
then
textout_p("Applying plot options...",G0,1,1,1,0,320,#FFFFFFh);
if xmintemp>=xmaxtemp then
msgbox("Warning: Invalid Xmin/Xmax! Setting Xmax:=Xmin+1");
xmaxtemp:=xmintemp+1;
end;
if ymintemp>=ymaxtemp then
msgbox("Warning: Invalid Ymin/Ymax! Setting Ymax:=Ymin+1");
ymaxtemp:=ymintemp+1;
end;
if rtemp<0 then
msgbox("Warning: Box size must be >= 0; reset to 4");
rtemp:=4;
end;
if (xmintemp<>Xmin) OR (xmaxtemp<>Xmax) OR
(ymintemp<>Ymin) OR (ymaxtemp<>Ymax)
then
Xmax:=xmaxtemp; Xmin:=xmintemp;
Ymax:=ymaxtemp; Ymin:=ymintemp;
end;
if rtemp<>r then
r:=rtemp;
end;
if ctemp<>c then
c:=ctemp;
end;
if coloringtemp<>coloring then
coloring:=coloringtemp;
end;
if REGridOntemp<>REGridOn then
REGridOn:=REGridOntemp;
end;
if IMGridOntemp<>IMGridOn then
IMGridOn:=IMGridOntemp;
end;
end;
end;
EXPORT Plot()
BEGIN
if initComp==0 then
gComp_setdefault();
end;
local x1,x2,y1,y2,co;
local dx:=(Xmax-Xmin)/320;
local dy:=(Ymax-Ymin)/240;
local z0,z1;
local a,b,d,k,x,y,dd;
d:=2^r;
FOR x FROM 0 TO 320-d STEP d DO
FOR y FROM 0 TO 240-d STEP d DO
z1:=Xmin+x*dx+i*(Ymax-y*dy);
co:=EvalF(z1);
RECT_P(G0,x,y,x+d-1,y+d-1,co);
END;
END;
IF r>0 THEN
FOR k FROM 1 TO r DO
d:=2^(r-k); dd:=2*d;
FOR x FROM 0 TO 160/d-1 DO
a:=x*dd;
z1:=Xmin+a*dx+i*(Ymax+d*dy);
FOR y FROM 0 TO 120/d-1 DO
b:=y*dd+d;
z1:=z1-i*dd*dy;
co:=EvalF(z1);
RECT_P(G0,a,b,a+d-1,b+d-1,co);
z0:=z1+d*dx;
co:=EvalF(z0);
RECT_P(G0,a+d,b,a+dd-1,b+d-1,co);
z0:=z0+i*d*dy;
co:=EvalF(z0);
RECT_P(G0,a+d,b-d,a+dd-1,b-1,co);
END;
END;
END;
END;
FREEZE;
END;
EvalF(z)
BEGIN
IF RE(z) THEN
RETURN(GetColor(F1(z)));
ELSE
RETURN(GetColor(F1(z+.001)));
END;
END;
SetHSV(h, s, v)
BEGIN
LOCAL r, g, b;
LOCAL z, f, p, q, t, i;
IF(s==0) THEN
r:=v;
g:=v;
b:=v;
ELSE
IF(h==1) THEN h := 0; END;
z := h*6;
i := IP(z);
f := FP(z);
p := v*(1-s);
q := v*(1-s*f);
t := v*(1-s*(1-f));
CASE
IF i==0 THEN r:=v; g:=t; b:=p; END;
IF i==1 THEN r:=q; g:=v; b:=p; END;
IF i==2 THEN r:=p; g:=v; b:=t; END;
IF i==3 THEN r:=p; g:=q; b:=v; END;
IF i==4 THEN r:=t; g:=p; b:=v; END;
IF i==5 THEN r:=v; g:=p; b:=q; END;
END;
END;
r :=MIN(255,IP(256*r));
g :=MIN(255,IP(256*g));
b :=MIN(255,IP(256*b));
RETURN RGB(r,g,b);
END;
GetColor(v)
BEGIN
LOCAL a:=0;
LOCAL m,k,sat,val;
IF v≠0 THEN a:=ARG(v); END;
a:=a MOD (2*π);
a := a/(2*π);
IF coloring==1 THEN a:=a/6; END;
// RE Contour
IF REGridOn then
m := ABS(RE(v));
k:=m/c;
IF k>1 then
k:=(k/e^FLOOR(LN(k)) -1)*em1;
END;
sat:=2*k;
IF k>=0.5 THEN sat:=2-sat; END;
val := 1-0.4*sat^3;
sat := 1 - (1-sat)^3; sat := 0.4 + sat*0.6;
IF (val > 0.9999) OR (sat >0.9999) THEN
IF coloring==3 THEN return RGB(200,200,200); END;
return SetHSV(a,sat,val);
END;
END;
//IM Contour
IF IMGridOn then
m := ABS(IM(v));
k:=m/c;
IF k>1 then
k:=(k/e^FLOOR(LN(k)) -1)*em1;
END;
sat:=2*k;
IF k>=0.5 THEN sat:=2-sat; END;
val := 1-0.4*sat^3;
sat := 1 - (1-sat)^3; sat := 0.4 + sat*0.6;
IF (val > 0.9999) OR (sat >0.9999) THEN
IF coloring==3 THEN return RGB(255,255,255); END;
return SetHSV(a,sat,val);
END;
END;
//Domain Coloring
IF coloring==3 THEN
return RGB(MIN(255,LN(1+ABS(IM(v)))*128),MIN(255,LN(1+ABS(RE(v)))*128),MIN(255,MAX(0,(LN(1+ABS(v))-2)*128)));
END;
m := ABS(v);
k:=m/c;
IF k>1 then
k:=(k/e^FLOOR(LN(k)) -1)*em1;
END;
sat:=2*k;
IF k>=0.5 THEN sat:=2-sat; END;
val := 1-0.4*sat^3;
sat := 1 - (1-sat)^3; sat := 0.4 + sat*0.6;
return SetHSV(a,sat,val);
END;
I opted to leave out the PIXON code since there was not much improvement and yet much larger code.
Search
Member List
Calendar
Help
