{Jozef Sivek ml. januar 2004
priame premietanie priestorovych objektov na plochu,
mandelbrotova mnozina, odvodene od 3df, akurat zmenena fx()
}
program _3dfunkcionalna_analyza_mandelbrotova_mnozina;
uses Graph,crt;

const top=58;

type    pole_v=array[1..3] of real;
        pole_v_int=array[1..2] of integer;
        baza=array[1..3] of pole_v;

        pole=array[0..top,0..top] of pole_v;{matrica grafu}
        pole_screen=array[0..top,0..top] of pole_v_int;


var
 Gd, Gm: Integer;
 maxxdiv2,maxydiv2,maxx:word;{graficke rozlisenie delene dvomi}
 input_key:char;

 core:baza;{hl baza}
 p:baza;{baza pozorovatela, 1 je dopredu, 2 je doprava a 3 je hore voci pozorovatelovy}


 alfa,beta:real;{uhol v rad, alfa h, beta v}
 movev_const:real;{pohybova konstanta}

 m:pole;{graf}
 x,y,z:pole_v;{ohranicenia zobrazenia grafu}
 no:pole_v_int;{pocet segmentov }

 mierka:word;{pocet pixelov na jednotku dzky}

 tipe_of_rendering:byte;
 show_xyz:boolean;

 {color management}
 g_color:byte;
 g_color_xyz:byte;
 g_color_txt:byte;

 {animation management}
 motion_time:word;


 label citaj;{skok pre znovunacitanie klavese}

function fx(x,y:real):real;

         const lim=30;
         var poc:integer;
              z,c:pole_v;
              overflow:boolean;
              exp:word;
         {}

         procedure umocni(var input:pole_v; exp:integer; var overflow:boolean);
          var c,cx:pole_v;
              I:integer;
          begin
          {a+bi * c+di =
               (ac - bd) + (ad + bc)i}
          c[1]:=1;
          c[2]:=0;
          for I:=1 to exp do begin
                          cx[1]:=c[1]*input[1] - c[2]*input[2];
                          c[2]:=c[1]*input[2] + c[2]*input[1];
                          c[1]:=cx[1];
                          if (sqr(c[1]) + sqr(c[2])) > 100 then begin
                                                                 overflow:=true;
                                                                 exit;
                                                                 end;
                             end;
          input[1]:=c[1];
          input[2]:=c[2];
          end;

         begin
          exp:=2;
          poc:=0;
          overflow:=false;

           z[1]:=0;z[2]:=0;
           c[1]:=(x-0.7);
           c[2]:=(y);
           repeat
            umocni(z,exp,overflow);

            z[1]:=z[1]+c[1];
            z[2]:=z[2]+c[2];
            inc(poc);
           until (poc >= lim) or ( ( sqr(z[1]) + sqr(z[2]) ) > 4) or overflow;
           if poc>=lim then fx:=0.3
                       else fx:=(poc/lim)*0.3;

         end;

procedure define_fx;
          begin
          x[1]:=-1.5;x[2]:=1.5;
          y[1]:=-1.5;y[2]:=1.5;
          z[1]:=-40;z[2]:=40;
          end;

procedure solve;
          var osx,osy:integer;
              px,py:real;

          begin
          for osy:=0 to (no[2]-1) do begin
              py:=y[1] + abs(y[1]-y[2]) * osy/(no[2]-1);
              for osx:=0 to (no[1]-1) do begin
                     px:=x[1] + abs(x[1]-x[2]) * osx/(no[1]-1);

                     m[osx,osy][1]:=px;
                     m[osx,osy][2]:=py;
                     m[osx,osy][3]:=fx(px,py);

                     end;end;
          end;

procedure refresh;
          begin
          maxxdiv2:=getmaxx div 2;
          maxydiv2:=getmaxy div 2;
          maxx:=getmaxx;

          p[1][1]:=-1; p[1][2]:=0; p[1][3]:=0;
          p[2][1]:=0; p[2][2]:=1; p[2][3]:=0;
          p[3][1]:=0; p[3][2]:=0; p[3][3]:=1;

          core[1][1]:=1; core[1][2]:=0; core[1][3]:=0;
          core[2][1]:=0; core[2][2]:=1; core[2][3]:=0;
          core[3][1]:=0; core[3][2]:=0; core[3][3]:=1;

          alfa:=pi/20;
          beta:=alfa;
          movev_const:=1;

          mierka:=100;

          no[1]:=30;
          no[2]:=no[1];

          tipe_of_rendering:=1;
          show_xyz:=true;

          g_color:=2;
          g_color_xyz:=1;
          g_color_txt:=15;

          motion_time:=200;

          solve;

          end;

procedure spinh(input:integer);{rotacia pozorovatela v horizontalnej rovine, okolo O}
          var I,M:integer;
              v:baza;
              alfa_my:real;
          begin
          alfa_my:=input * alfa;
          for I:=1 to 3 do begin
                     v[I][1]:=p[I][1] * cos(alfa_my) - p[I][2] * sin(alfa_my);
                     v[I][2]:=p[I][1] * sin(alfa_my) + p[I][2] * cos(alfa_my);
                     v[I][3]:=p[I][3];
                           end;
          for I:=1 to 3 do begin
                   for M:=1 to 3 do p[I][M]:=v[I][M];
                           end;

          end;

procedure spinv(input:integer);{rotacia pozorovatela vo vertikalnej rovine, okolo O}
          var v:baza;
              I:integer;
              beta_my:real;
          begin
          beta_my:=input * beta;

          for I:=1 to 3 do
          v[3][I]:=cos(beta_my) * p[3][I] + sin(beta_my) * p[1][I];
          for I:=1 to 3 do
          v[1][I]:=cos(beta_my) * p[1][I] - sin(beta_my) * p[3][I];

          for I:=1 to 3 do begin
                           p[3][I]:=v[3][I];
                           p[1][I]:=v[1][I];
                           end;
          end;

procedure movev(input:integer);
          var osx,osy:integer;
          begin
          for osy:=0 to (no[2]-1) do
              for osx:=0 to (no[1]-1) do begin
                  m[osx,osy][3]:=m[osx,osy][3] + input * movev_const;
              end;
          end;

procedure init_g;
          begin
          gd:=detect;
          initgraph(gd,gm,'c:/bp/bgi');
          if graphresult <> grok then halt(1);
          {koniec inicializacie}
          end;

procedure close_g;
          begin
          Closegraph;
          end;

procedure draw_point(a:pole_v_int; color:byte);
          begin
          putpixel(a[1] + (maxxdiv2),(maxydiv2) - a[2],color);
          end;

procedure draw_line(a,b:pole_v_int; color:byte);
          begin
          setcolor(color);
          line(a[1] + (maxxdiv2),(maxydiv2) - a[2],b[1] + (maxxdiv2),(maxydiv2) - b[2]);
          end;

procedure draw_moveto(a:pole_v_int);
          begin
          moveto(a[1] + (maxxdiv2),(maxydiv2) - a[2]);
          end;

procedure draw_lineto(a:pole_v_int; color:byte);
          begin
          if abs(a[1])+abs(a[2]) < maxx then begin
                                             setcolor(color);
                                             lineto(a[1] + (maxxdiv2),(maxydiv2) - a[2]);
                                             exit;
                                             end;
          draw_moveto(a);
          end;


procedure write_onscreen(x,y:integer; input:string; color:byte);
          var ch:string;
          begin
          setcolor(color);
          outtextxy(x + (maxxdiv2),(maxydiv2) - y,input);
          end;


procedure solve_point(point:pole_v; var screen_point:pole_v_int);
          var real_point:pole_v;
              I,M:integer;
          begin
          for I:=1 to 3 do
          real_point[I]:=core[1][I]*point[1] + core[2][I]*point[2] + core[3][I]*point[3];
          {toto monstrum je ako keby nova moznost menenie priestoru}


          screen_point[1]:=round( mierka * (p[2][1] * real_point[1] + p[2][2] * real_point[2] + p[2][3] * real_point[3]));
          screen_point[2]:=round( mierka * (p[3][1] * real_point[1] + p[3][2] * real_point[2] + p[3][3] * real_point[3]));
          end;


procedure render_point(x,y,z:real; color:byte);
          var point:pole_v;
              screen_point:pole_v_int;
          begin
          point[1]:=x;
          point[2]:=y;
          point[3]:=z;

          solve_point(point,screen_point);

          draw_point(screen_point,color);
          end;

procedure render_line(x,y,z,x2,y2,z2:real; color:byte);
          var point:pole_v;
              screen_point,screen_point2:pole_v_int;
          begin
          point[1]:=x;
          point[2]:=y;
          point[3]:=z;
          solve_point(point,screen_point);

          point[1]:=x2;
          point[2]:=y2;
          point[3]:=z2;
          solve_point(point,screen_point2);

          draw_line(screen_point,screen_point2,color);
          end;

procedure render_xyz(a:real; ch:char);
          var x,y,z:string;
              px,py,pz:pole_v_int;
              point:pole_v;
          begin
          render_line(-a/2,0,0, a,0,0  ,g_color_xyz);
          render_line(0,-a/2,0, 0,a,0  ,g_color_xyz);
          render_line(0,0,-a/2, 0,0,a  ,g_color_xyz);

          if ch='t' then begin
              point[1]:=a;point[2]:=0;point[3]:=0;
              solve_point(point,px);
              point[1]:=0;point[2]:=a;point[3]:=0;
              solve_point(point,py);
              point[1]:=0;point[2]:=0;point[3]:=a;
              solve_point(point,pz);

              if a>0 then x:=''   {dost nemotorne ale nenapada ma inak}
              else x:='-';
                x:=x+'x';
              if a>0 then y:=''
              else y:='-';
                y:=y+'y';
              if a>0 then z:=''
              else z:='-';
                z:=z+'z';

              write_onscreen(px[1],px[2],x,g_color_txt);
              write_onscreen(py[1],py[2],y,g_color_txt);
              write_onscreen(pz[1],pz[2],z,g_color_txt);
                         end;
          end;


procedure render_fx(tip:byte);
          var osy,osx:integer;
              matica: pole_screen;
          begin

          for osy:=0 to (no[2]-1) do
              for osx:=0 to (no[1]-1) do begin
              case tip of
              0: begin
                 if ((z[1] < m[osx,osy][3]) and (m[osx,osy][3] < z[2])) then
                 render_point(m[osx,osy][1],m[osx,osy][2],m[osx,osy][3],g_color);
                 end;
              1: begin
     {         if ((z[1] < m[osx,osy][3]) and (m[osx,osy][3] < z[2])) then begin
     if osx<(no[1]-1) then
     render_line(m[osx,osy][1],m[osx,osy][2],m[osx,osy][3],  m[osx+1,osy][1],m[osx+1,osy][2],m[osx+1,osy][3],g_color);

     if osy<(no[2]-1) then
     render_line(m[osx,osy][1],m[osx,osy][2],m[osx,osy][3],  m[osx,osy+1][1],m[osx,osy+1][2],m[osx,osy+1][3],g_color);

                                                                          end;
     }
                 solve_point(m[osx,osy], matica[osx,osy]);

                 end;
              end;

                                        end;
          case tip of {v pripade, ze sa kresli mriezka tak sa vykresli z pola matica
                      dufam, ze sa tim renderovanie zrychli aspon dvojnasobne
                      }
             1: begin
              for osy:=0 to (no[2]-1) do begin
              draw_moveto(matica[0,osy]);
              for osx:=0 to (no[1]-1) do begin
                         draw_lineto(matica[osx,osy],g_color)
                                         end;end;

              for osx:=0 to (no[2]-1) do begin
              draw_moveto(matica[osx,0]);
              for osy:=0 to (no[1]-1) do begin
                         draw_lineto(matica[osx,osy],g_color)
                                         end;end;

                end;
          end;


          end;

procedure clear_scene;
          begin
          clearviewport;
          end;

procedure render_scene;
          begin
           render_fx(tipe_of_rendering);
           if show_xyz then render_xyz(1.2,'t');

          end;

begin
write('= 3d f');
writeln('od Jozef Sivek (c)2004':50);
{help('t');}

{init}
init_g;

define_fx;
refresh;



repeat
clear_scene;

render_scene;

citaj:;
input_key:=readkey;

{dufam, ze to bude stacit}

   case input_key of
   #63,#32: begin refresh;solve; end;{F5,medzernik}

   #72: {otocka hore/spin up}spinv(1);
   #80: {otocka dole/spin down}spinv(-1);
   #77: {otocka vpravo/spin right}spinh(1);
   #75: {otocka vlavo/spin left}spinh(-1);

   #73: movev(1);{pg up}
   #81: movev(-1);{pg down}

   #45: begin dec(mierka,10);if mierka<1 then mierka:=2; end;{-}
   #43:inc(mierka,10);{+}

{editacia grafu}
   #110: begin dec(no[1],1);if no[1]<=1 then no[1]:=2; no[2]:=no[1]; solve; end;{n}
   #78:  begin inc(no[1],1);if no[1]>top then no[1]:=top; no[2]:=no[1]; solve; end; {N}

   #102: begin {f}
         if tipe_of_rendering=1 then tipe_of_rendering:=0
            else tipe_of_rendering:=1;
         end;
   #120,#121,#122: show_xyz:=not(show_xyz);{x,y,z - vypnutie osi}

   #103: begin inc(g_color);if g_color=16 then g_color:=0; end;{g - zmena farby}

   #109: begin{m ako motion}
         repeat
         clear_scene;
         spinh(1);
         render_scene;
         delay(motion_time);
         until keypressed;
         end;

   #27:Halt;{esc}
   else goto citaj;
   end;
until input_key=#27;
close_g;
end.