{Jozef Sivek ml. jul 2005
fraktalove uholniky - upravena verzia
}

program mnohouholnik;
uses graph,crt;

type pole_v=array[1..2] of real;
     vrcholi=array[1..1000] of pole_v;

var
 gd, gm: Integer;
 m:vrcholi;
 n:word;
 d:real;
 g_color,g_color_txt,g_color_actual:byte;
 lim:longint;{iteracna medza}
 in_key:char;{kod klavesy}
 render_mod:boolean;{renderovaci mod}
 first_run:boolean;{prvy start}

 label read_again;

function generuj(n:word):word;{vrati cislo jedneho z vrcholov}
         var c:real;

         begin

         c:=random*n;
         generuj:=(trunc(c)+1);

         end;

procedure move_point(var point,destination:pole_v; d:real);
          var move: pole_v;

          begin
          move[1]:=(destination[1] - point[1]) * (1-1/d);
          move[2]:=(destination[2] - point[2]) * (1-1/d);

            point[1]:=point[1] + move[1];
            point[2]:=point[2] + move[2];
          end;

procedure draw(point:pole_v);
          begin
          putpixel(round(point[1]),round(point[2]),g_color_actual);
          end;

procedure write_onscreen(n:integer;d:real);
          var ch,ch2,ch_render_mod:string;
          begin
          if render_mod=true then ch_render_mod:=' [circle]'
             else ch_render_mod:=' [rand]';

          setcolor(g_color_txt);
          str(n,ch);
          ch:=ch+'-uhol.;koef=';
          str((1/d):1:5,ch2);
          ch:=ch+ch2;
          ch:=ch+ch_render_mod;
          outtextxy(400,470,ch);
          end;

procedure make_points;{vygeneruje pole vertexov}
          var I:integer;
          begin
          {vertexy su v kruhu}
          if render_mod=true then begin
          for I:= 1 to n do begin
                            m[I][1]:=getmaxx/2  + sin( ((2*pi)/n) * I ) * (getmaxy/2);
                            m[I][2]:=getmaxy/2  - cos( ((2*pi)/n) * I ) * (getmaxy/2);
                            end;
                                   end;
          {vertexy su nahodne generovane}
          if render_mod=false then begin
          for I:= 1 to n do begin
                            m[I][1]:=random*getmaxx*0.9;
                            m[I][2]:=random*getmaxy*0.9;
                            end;
                                   end;
          end;

procedure iteruj(n:word; d:real);
          var
              no:word;
              point:pole_v;
              g:longint;

          begin
          if n>=1000 then n:=999;

          point[1]:=m[1][1];
          point[2]:=m[1][2];

          g:=0;
          repeat
          inc(g);
            no:=generuj(n);
            g_color_actual:=g_color+no;
            if g_color_actual mod 16 = 0 then inc(g_color_actual,5);

            move_point(point,m[no],d);

            draw(point);
          until (g=lim) or keypressed;

          end;

begin
writeln('Jozef Sivek ml. jul 2005');
writeln('xUholnik');
writeln('- kurzorove sipky > zmena poctu vrcholov a delitela');
writeln('- "m" > zmena modu; |SPACE| > refresh; |Esc| > exit');
writeln('stlacte |Enter| pre pokracovanie');
readln;

 gd := Detect;
 InitGraph(gd, gm,'c:/bp/bgi');
 if GraphResult <> grOk then
   Halt(1);

randomize;{dajte pozor kam strkate tuto proceduru, raz som ju casto
          volal a program bol neodolatelne pomaly;}

n:=3;{pocet vrcholov}
d:=3;{delitel}
render_mod:=true;
first_run:=true;
g_color:=4;
g_color_txt:=15;
lim:=20000000;

repeat
read_again:;
if not first_run then in_key:=readkey
   else first_run:= not first_run;

 case in_key of
 #27: halt;{exit}

 #72{up}: begin inc(n); if n>950 then dec(n); make_points; end;
 #80{down}: begin dec(n); if n<2 then inc(n); make_points; end;

 #77{right}: begin d:=d-0.07; if d<1 then d:=1.001;end;
 #75{left}: begin d:=d+0.07; end;

 #109{m}: begin render_mod:=not render_mod;make_points; end;

 #32{space}:{refresh}make_points;

 else
      goto read_again

 end;

 g_color:=1+trunc(random*15);

 clearviewport;

write_onscreen(n,d);
iteruj(n,d);

until in_key=#27;

 CloseGraph;
end.