{Jozef Sivek ml. 19.december 2004
tour de la mandelbrot
cista aplikacia procedur z ukazky fract.pas
}
program fract;
uses crt, graph;

type pole_v=array[1..2] of real;{klasicky vektorovy priestor}
type pole_v_int=array[1..2] of integer;{-//- pre cele cisla}

var g_position,g_size:pole_v;{ohranicenie mnoziny}
    position,size:pole_v_int;{ohranicenie okna}
    g_color_m,g_color_start,g_color_no:word;{color management}
    which:boolean;{ktora mnozina 0 je m  a 1 je j}
    input,exp:integer;
    gd,gm:integer;
    lim:word;
    c_j:pole_v;{c pre juliu}

procedure init;
          begin

        g_position[1]:=-4;
        g_position[2]:=3;
        g_size[1]:=8;

       which:=false;
       exp:=2;

       position[1]:=0;
       position[2]:=0;
       size[1]:=getmaxx;
       size[2]:=getmaxy;

       g_color_m:=0;
       g_color_start:=1;
       g_color_no:=15;

       randomize;

          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;

function is_good_point(position:pole_v_int):boolean;{je to zaujimava funkcia, ktorej ulohou
                                  je pomuoct najst bod na hrane mandelbrotovej
                                  mnoziny}
         var core:word;
             okolie:byte;
          begin
          core:=getpixel(position[1],position[2]);
          okolie:=0;
          if core = g_color_m then is_good_point:=false
             else begin
                  {hore}
                  if getpixel(position[1]-1,position[2]-1) = g_color_m then inc(okolie);
                  if getpixel(position[1],position[2]-1) = g_color_m then inc(okolie);
                  if getpixel(position[1]+1,position[2]-1) = g_color_m then inc(okolie);

                    is_good_point:=(okolie>0);
                    if (okolie>0) then exit;

                  {dole}
                  if getpixel(position[1]-1,position[2]+1) = g_color_m then inc(okolie);
                  if getpixel(position[1],position[2]+1) = g_color_m then inc(okolie);
                  if getpixel(position[1]+1,position[2]+1) = g_color_m then inc(okolie);

                    is_good_point:=okolie>0;
                    if (okolie>0) then exit;


                  {vlavo vpravo}
                  if getpixel(position[1]-1,position[2]) = g_color_m then inc(okolie);
                  if getpixel(position[1]+1,position[2]) = g_color_m then inc(okolie);

                    is_good_point:=okolie>0;
                    exit;

                  end;
          end;

procedure draw(x,y:integer; color:word);{tato procedura posluzi hl. tym co tento program budu "objektovat"}
          begin
          {max hodnota color je vlastne lim!}

          if color>=lim then putpixel(x,y,g_color_m)
                        else putpixel(x,y,g_color_start + color mod g_color_no);

          end;

{umocnenie komplexneho cisla}
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])) > 50   then begin
                                                                 overflow:=true;
                                                                 exit;
                                                                 end;
                             end;
          input[1]:=c[1];
          input[2]:=c[2];
          end;


procedure generate(position, size: pole_v_int);{vygenerovanie mnoziny}

         var poc:word;{vnorenie}
             x,y:integer;{poloha na obrazovke}
             z,c_m:pole_v;
             c:pole_v;{zjednoteny prameter, dufam, ze to bude rychlejsie}
             overflow:boolean;{kontrola mozneho pretecenia}
         begin
         exp:=abs(exp);
         size[1]:=abs(size[1])-1;{to -1 pretoze sa pocita od 0}
         size[2]:=abs(size[2])-1;{pre nezbednych nechcem si predstavovat co by to robilo pri R-}

         {taka pmuocka, v podstate ju netreba}
         setcolor(1);
         line(position[1],position[2],position[1]+size[1],position[2]);

         {kedze juliova mnozina ma c_j ako konstantu}
                if which=true then begin
                                c[1]:=c_j[1];
                                c[2]:=c_j[2];
                                end;


          for x:=0 to size[1] do begin
          for y:=0 to size[2] do begin

                   overflow:=false;

                   if which=false then begin
                                   z[1]:=0;z[2]:=0;{vychodzi parameter}
                                   c[1]:=g_position[1] + (x/size[1]) * g_size[1];{realne koordinaty  daneho bodu}
                                   {c[2]:=g_position[2] - (y/size[2]) * g_size[2]; }
                                   {ak by sme chceli zachovat pomery mierky tak:}
                                   c[2]:=g_position[2] - (y/size[2]) * (size[2]/size[1]) * g_size[1];

                                   {takto to bolo
                                   c_m[1]:=(x-(getmaxX / 2))/(getmaxx div 4);
                                   c_m[2]:=(y-(getmaxY / 2))/(getmaxx div 4);

                                   a zas pre juliu
                                   z[1]:=(x-(getmaxX / 2))/(getmaxY div 4);
                                   z[2]:=(y-(getmaxY / 2))/(getmaxY div 4);
                                   }
                                   end;
                   if which=true then begin
                                   z[1]:=g_position[1] + (x/size[1]) * g_size[1];{nachadzanie realnych koordinatov pre bod}
                                   z[2]:=g_position[2] - (y/size[2]) * g_size[2];
                                   {c je vychodzi parameter pre generovanie mnoziny
                                   a definuje sa externe}
                                   end;

               {boogie woogie, alebo ide sa na skumat vlastnost bodu}

               poc:=0;
               repeat
               umocni(z,exp,overflow);
               z[1]:=z[1]+c[1];
               z[2]:=z[2]+c[2];
               inc(poc);
               until (poc >= lim) or overflow or ( ( sqr(z[1]) + sqr(z[2]) ) > 4);

               {nakoniec nakreslime bod}
               draw(position[1]+x,position[2]+y,poc);

          end;end;


         end;

var I,M:integer;
    screen:pole_v_int;
    point:pole_v;
    my_size:real;
    poc:byte;{hlbka priblizenia}

begin
write('= tour de la Mandelbrot');
writeln('od Jozef Sivek (c)2004':50);
writeln('press Enter to begin and then to close!');
readln;
init_g;

repeat
init;
lim:=80;
poc:=0;

repeat


 generate(position,size);
 inc(poc);

 {vybranie bodu priblizenia}
   repeat
     screen[1]:=100+round(random*(getmaxx-200));
     screen[2]:=80+round(random*(getmaxy-160));
   until is_good_point(screen) or keypressed;
 {prepocitame aky je to bod v skutocnosti}
 point[1]:=g_position[1] + ((screen[1]/getmaxx) * g_size[1]);
 point[2]:=g_position[2] - ((screen[2]/getmaxy) * (getmaxy/getmaxx) * g_size[1]);
 {ak by ste chceli upravovatprogram pre okno, treba prepisat predchadzajuce riadky}

 {oznacime si vybraty bod nech divaci vedia kam sa poberame}
 setcolor(15);{biela}
   fillellipse(screen[1],screen[2],5,5);
 setcolor(8);
   fillellipse(screen[1],screen[2],2,2);

 {treba zvisit presnost takze}
 inc(lim,15);
 lim:=lim+2*poc;

 {vypocitam nove ohranicenie}
 g_size[1]:=g_size[1]/4;
 my_size:=g_size[1]/2;

 g_position[1]:=point[1]-my_size;
 g_position[2]:=point[2]+(getmaxy/getmaxx)*my_size;


until keypressed or (poc>6);
until keypressed;


close_g;
end.