Complex Plotting App

[Han]

Usage: Plot(r) where the initial resolution is a grid of squares of size \( 2^r \times 2^r \). On the emulator, this modified version takes half the time vs. the original. On the calculator, the modified version takes 75% of the time of the original.

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

SetHSV(h,s,v);
GetColor(v);
EvalF();

EXPORT Plot(r)
BEGIN
  local x1,x2,y1,y2,co;
  local dx:=(Xmax-Xmin)/320;
  local dy:=(Ymax-Ymin)/240;
  local z1;
  local a,b,d,k,x,y;

  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*(Ymin+y*dy);
      co:=EvalF(z1);
      RECT_P(G0,x,y,x+d-1,y+d-1,co); 
    END;
  END;

IF r THEN
  FOR k FROM 1 TO r 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+d;
        z1:=Xmin+a*dx+i*(Ymin+b*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;
END;

  FREEZE;
//  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,ranges,rangee,k,sat,val;

    IF v≠0 THEN a:=ARG(v); END;
    WHILE (a<0) DO a := a+ (2*π); END;
    a := a/(2*π);

// RE Conformal mapping
    m := ABS(RE(v));
    ranges := 0;
    rangee := 1;

    WHILE(m>rangee) DO
        ranges := rangee;
        rangee := rangee * e;
    END;

    k:=(m-ranges)/(rangee-ranges);
    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 return SetHSV(a,sat,val); END;

//IM Conformal mapping
    m := ABS(IM(v));
    ranges := 0;
    rangee := 1;

    WHILE(m>rangee) DO
        ranges := rangee;
        rangee := rangee * e;
    END;

    k:=(m-ranges)/(rangee-ranges);
    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 return SetHSV(a,sat,val); END;

//Domain Coloring
    m := ABS(v);
    ranges := 0;
    rangee := 1;

    WHILE(m>rangee) DO
        ranges := rangee;
        rangee := rangee * e;
    END;

    k:=(m-ranges)/(rangee-ranges);
    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;

    return SetHSV(a,sat,val);
END;