{program na zobrazenie Lorenzovho atraktora - pre viac info. vid. Wikpedia,
a to puodorysu, bokorisu a pohladu zpredu.

Jozef Sivek ml.ad. 20.5.2006
}
program lorenz_attractor;
uses graph,crt;
{par slov som tu napisal aj ja, Misko Sivek}
type vector=array[1..3] of real;
     window=record
        wx,wy:integer;
        w,h:integer;
        a:real;
        ox,oy:real;{origin}
     end;

var sigma,ro,beta:real;
    gm,gd:integer;
    in_key:char;
    position:vector;
    i:integer;
    dt:real;
    color:word;
    magnification:real;
    okno_xy,okno_yz,okno_xz:window;

    label skok;
{zapne grafiku}
procedure graph_on;
          begin
          Gd := Detect;
          InitGraph(Gd, Gm,'c:/bp/bgi');
          if GraphResult <> grOk then
             Halt(1);
          end;

{vypne ju}
procedure graph_off;
          begin
          CloseGraph;
          end;

{iteracna funkcia pre lorenzov atraktor -> vid. Wikipedia.org}
procedure iter(input:vector; dt:real; var output:vector);
          var point,dx:vector;

          begin
          point[1]:=input[1];
          point[2]:=input[2];
          point[3]:=input[3];

          dx[1]:=(sigma*(input[2]-input[1]))*dt;
          dx[2]:=(input[1]*(ro-input[3])-input[2])*dt;
          dx[3]:=(input[1]*input[2]-beta*input[3])*dt;

          output[1]:=dx[1]+point[1];
          output[2]:=dx[2]+point[2];
          output[3]:=dx[3]+point[3];
          end;

{vycisti obrazovku a nakresli ramy okien}
procedure refresh;
          begin
          setbkcolor(0);
          clearviewport;
          setcolor(red);

          rectangle(okno_xy.wx,okno_xy.wy,okno_xy.wx+okno_xy.w,okno_xy.wy+okno_xy.h);
          rectangle(okno_yz.wx,okno_yz.wy,okno_yz.wx+okno_yz.w,okno_yz.wy+okno_yz.h);
          rectangle(okno_xz.wx,okno_xz.wy,okno_xz.wx+okno_xz.w,okno_xz.wy+okno_xz.h);


          end;

{kresli do okien}
procedure draw_on_screen(inx,iny:real;okno:window;color:word);
          var x,y:real;
          begin
          inx:=inx-okno.ox;
          iny:=iny-okno.oy;
          if not ((abs(inx/okno.a)>1) or (abs(iny/(okno.a*okno.h/okno.w))>1)) then begin
             x:=(inx/okno.a)*(okno.w/2);
             y:=(iny/(okno.a*okno.h/okno.w))*(okno.h/2);
             putpixel(round(x+okno.wx+okno.w/2),round(-y+okno.wy+okno.h/2),color);
             end;
          end;

{vykresli vsetky pohlady na Lorenzov atraktor > osi xy, yz, xz}
procedure draw(input:vector;color:word);
          begin
          draw_on_screen(input[1],input[2],okno_xy,color);
          draw_on_screen(input[2],input[3],okno_yz,color);
          draw_on_screen(input[1],input[3],okno_xz,color);
          {writeln(input[1]:5:2,'|',input[2]:5:2,'|',input[3]:5:2);}
          end;

begin
writeln('Lorenzov atraktor (ro,sigma,beta)              Jozef Sivek ml.ad.20.5.2006');
skok:write('chcete zadat parametre ro,beta a sigma? Bezne su 14, 8/3 a 10. > y/n: ');
readln(in_key);
in_key:=upcase(in_key);
if in_key='Y' then begin
                   write('ro=');
                   readln(ro);
                   write('beta=');
                   readln(beta);
                   write('sigma=');
                   readln(sigma);
                   end
  else begin
       sigma:=10;
       ro:=28;
       beta:=8/3;
       end;


okno_xy.wx:=0;
okno_xy.wy:=20;
okno_xy.h:=400;
okno_xy.w:=210;
okno_xy.a:=20;
okno_xy.ox:=0;
okno_xy.oy:=0;

okno_yz.wx:=210;
okno_yz.wy:=20;
okno_yz.h:=400;
okno_yz.w:=210;
okno_yz.a:=okno_xy.a;
okno_yz.ox:=0;
okno_yz.oy:=25;

okno_xz.wx:=420;
okno_xz.wy:=20;
okno_xz.h:=400;
okno_xz.w:=210;
okno_xz.a:=okno_xy.a;
okno_xz.ox:=0;
okno_xz.oy:=25;

dt:=0.002;

i:=0;
color:=white;
magnification:=5;

position[1]:=0;
position[2]:=0.01;
position[3]:=0.01;

graph_on;
refresh;

while 1=1 do begin
    inc(i);
    if (i=0) or (i>(maxint-1)) then color:=random(15)+1;
    draw(position,color);
    iter(position,dt,position);
    delay(2);
    if keypressed then begin
                       in_key:=readkey;
                       if in_key=#27 then begin
                                          graph_off;
                                          write('chcete skoncit? > y/n: ');
                                          readln(in_key);
                                          in_key:=upcase(in_key);
                                          if in_key='Y' then halt else goto skok;
                                          end
                          else refresh;

                       end;
    end;
{Toto}
end.