RE: Complex Plotting App
I did some further major improvement on the complex plotting app today, as listed below:
1. Implemented Plot Setup Menu to select X min/max, Y min/max, pixel box size, contour/magmitude mask resolution, Coloring scheme, contour grid on/off. I referenced functions in Graph3D as templates for overriding the Plot Setup menu.
There is a small issue where the drop-down box implementation for coloring scheme is not working on the simulater.. but it works fine on the actual HP Prime. Graph3D is also showing the same problem with the "Type", so I guess maybe this is an issue with the simulator.
2. the program now uses PIXELON_P for the last sweep or when r is set to 0 (single sweep)
code below:
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;
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}},
{coloringtemp,{"Red-Yellow Domain Coloring","HSV Domain Coloring", "Logarithmic"},{20,30,3}},
{REGridOntemp,0,{90,10,4}},
{IMGridOntemp,0,{90,10,5}}
},
"Plot Setup",
{
"Xmin=", "Xmax=",
"Ymin=", "Ymax=",
"Box=", "Resolution=",
"Coloring",
"RE Contour Grid",
"IM Contour Grid"
},
{
"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",
"Select coloring scheme",
"Draw Real Contour Grids",
"Draw Imaginary Contour Grids"
})
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
local x1,x2,y1,y2,co;
local dx:=(Xmax-Xmin)/320;
local dy:=(Ymax-Ymin)/240;
local z1;
local a,b,b1,d,k,x,y;
// local r:=4; //r is size of initial square which is 2^r by 2^r pixels
d:=2^r;
IF r>0 THEN
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*(Ymin+(240-d-y)*dy);
co:=EvalF(z1);
RECT_P(G0,x,y,x+d-1,y+d-1,co);
END;
END;
FOR k FROM 1 TO r-1 DO
d:=2^(r-k);
FOR x FROM 0 TO 160/d-1 DO
FOR y FROM 0 TO 120/d-1 DO
a:=x*2*d; b:=y*2*d; b1:=(120/d-1-y)*2*d+d;
z1:=Xmin+a*dx+i*(Ymin+b1*dy);
co:=EvalF(z1);
RECT_P(G0,a,b,a+d-1,b+d-1,co);
z1:=z1+d*dx;
co:=EvalF(z1);
RECT_P(G0,a+d,b,a+2*d-1,b+d-1,co);
z1:=z1+i*d*dy;
co:=EvalF(z1);
RECT_P(G0,a+d,b-d,a+2*d-1,b-1,co);
END;
END;
END;
d:=1;
FOR x FROM 0 TO 160/d-1 DO
FOR y FROM 0 TO 120/d-1 DO
a:=x*2*d; b:=y*2*d; b1:=(120/d-1-y)*2*d+d;
z1:=Xmin+a*dx+i*(Ymin+b1*dy);
co:=EvalF(z1);
PIXON_P(G0,a,b,co);
z1:=z1+d*dx;
co:=EvalF(z1);
PIXON_P(G0,a+d,b,co);
z1:=z1+i*d*dy;
co:=EvalF(z1);
PIXON_P(G0,a+d,b-d,co);
END;
END;
ELSE
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*(Ymin+(240-d-y)*dy);
co:=EvalF(z1);
PIXON_P(G0,x,y,co);
END;
END;
END;
WHILE 1 DO
FREEZE;
END;
// WAIT(-1);
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 := FLOOR(h*6);
i := IP(z);
f := h*6 - 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;
// LOCAL c:=.01;
IF v≠0 THEN a:=ARG(v); END;
WHILE (a<0) DO a := a+ (2*π); END;
a := a/(2*π);
// RE Contour
IF REGridOn then
m := ABS(RE(v));
IF m>c then
k:=m/(c*e^FLOOR(LN(m)-LN(c))*(e-1)) - 1/(e-1);
ELSE
k:=m/c;
END;
IF (k<0.5) THEN
sat:=k*2;
ELSE
sat:=1 -(k -0.5) *2;
END;
val := sat;
sat := 1 - (1-sat)^3; sat := 0.4 + sat*0.6;
val := 1 - val;
val := 1 - (1-val)^3;
val := 0.6 + val*0.4;
IF (val > 0.9999) OR (sat >0.9999) THEN
IF coloring==1 THEN a:=a/6; ELSE IF coloring==3 THEN return RGB(200,200,200); END; END;
return SetHSV(a,sat,val);
END;
END;
//IM Contour
IF IMGridOn then
m := ABS(IM(v));
IF m>c then
k:=m/(c*e^FLOOR(LN(m)-LN(c))*(e-1)) - 1/(e-1);
ELSE
k:=m/c;
END;
IF (k<0.5) THEN
sat:=k*2;
ELSE
sat:=1 -(k -0.5) *2;
END;
val := sat;
sat := 1 - (1-sat)^3; sat := 0.4 + sat*0.6;
val := 1 - val;
val := 1 - (1-val)^3;
val := 0.6 + val*0.4;
IF (val > 0.9999) OR (sat >0.9999) THEN
IF coloring==1 THEN a:=a/6; ELSE IF coloring==3 THEN return RGB(255,255,255); END; 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);
IF m>c then
k:=m/(c*e^FLOOR(LN(m)-LN(c))*(e-1)) - 1/(e-1);
ELSE
k:=m/c;
END;
IF (k<0.5) THEN
sat:=k*2;
ELSE
sat:=1 -(k -0.5) *2;
END;
val := sat;
sat := 1 - (1-sat)^3; sat := 0.4 + sat*0.6;
val := 1 - val;
val := 1 - (1-val)^3;
val := 0.6 + val*0.4;
IF coloring==1 THEN a:=a/6; END;
return SetHSV(a,sat,val);
END;
|
Search
Member List
Calendar
Help
