{18.9.2003
Jozef Sivek ml.}
program eli006;
uses graph,crt;
type pole_v=array[1..3] of real;
var
     {-----------REGISTRE-----------------------------}
     gd,gm,monitor,cspining:integer;{c... su parametre citlivosti pohybu pozorovatela}
     artofmoveing:integer;{artof... je spuosob pohybu v priestore}
     i:char;{citanie klaves}
     vektorp,vektorpright,vektorpup,P,Pa,pseudo_posunutie:pole_v;{P=pozorovatel,Pa-traktor stred rotacie}
     dp,dright,dup,absp,abspright,abspup,cmoveing,P_Pa:real;{P_Pa je |P,PA|}
     label start;{Definujem len toto navestie z nevihnutnych duovodov, navestie start je na zaciatku hl.program.cyklu}
     {-----------/REGISTRE----------------------------}
{--objektove premenne--}
type pole_interval=array[1..2] of integer;
     pole_v_2d=array[1..2] of integer;
     pole_linear=array[0..3500] of pole_v;

type gulatype=record
     nh:integer;
     nv:integer;
     fii_h:pole_interval;
     fii_v:pole_interval;
     vektor_g_z:pole_v;
     vektor_g_x:pole_v;
     vektor_g_y:pole_v;
    end;
var gula: gulatype;
    obruc:pole_linear;

moveto_point:pole_v_2d;
moveto_1st:Byte;
{--/objektove premenne--}

var M:integer;

procedure nastavenia;
     begin
     setcolor(10);
     setbkcolor(0);
     cmoveing:=0.3; {citlivost pohybu}
     cspining:=4; {citlivost otacania}
     pseudo_posunutie[1]:=0;{pseudoposunutie je linearne posunutie objektov}
     pseudo_posunutie[2]:=0;{zmenou ich suradnic pri ich vykresleni.}
     pseudo_posunutie[3]:=0;
     vektorp[1]:=0;
     vektorp[2]:=1;
     vektorp[3]:=0;
     vektorpright[1]:=1;
     vektorpright[2]:=0;
     vektorpright[3]:=0;
     vektorpup[1]:=0;
     vektorpup[2]:=0;
     vektorpup[3]:=1;
     P[1]:=0; {pozorovatel}
     P[2]:=-20;
     P[3]:=0;
     Pa[1]:=0; {pozorovatel}
     Pa[2]:=0;
     Pa[3]:=0;
     monitor:=1280; {vzdialenost hlavy od monitoru}
     end;
procedure premenne;
          begin
          gula.nh:=24;
          gula.nv:=12;
          gula.fii_h[1]:=0;
          gula.fii_h[2]:=gula.nh;
          gula.fii_v[1]:=0;
          gula.fii_v[2]:=gula.nv;
          gula.vektor_g_z[1]:=0;
          gula.vektor_g_z[2]:=0;
          gula.vektor_g_z[3]:=1;
           gula.vektor_g_x[1]:=1;
           gula.vektor_g_x[2]:=0;
           gula.vektor_g_x[3]:=0;
            gula.vektor_g_y[1]:=0;
            gula.vektor_g_y[2]:=1;
            gula.vektor_g_y[3]:=0;

          artofmoveing:=1;
          end;

procedure blackbox(x,y,x2,y2:integer);
     var I:integer;
     begin
     setcolor(0);
     for I:=0 to (x2-x) do begin
                line(x+I,y,x+I,y2);
                          end;
     setcolor(10);
     end;

procedure f1;
     begin
     blackbox(0,0,550,110);
     sound(1200);
     delay(20);
     nosound;
     setcolor(15);
     outtextxy(0,0 ,'ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·');
     setcolor(6);
     outtextxy(0,10,'º     Prva pomoc pre 3Dstudio ELI / Quick help for ELI             º');
     setcolor(15);
     outtextxy(0,20,'º> sipkami sa otacate, pozor majte zapnuty NumLock!                º');
     outtextxy(0,30,'º> |F5| - prepnutie spuosobu pohybu.                               º');
     outtextxy(0,40,'º> |MEDZERNIK| - nastavenie vychodzich parametrov.                 º');
     outtextxy(0,50,'º> |F1| - Help.                                                    º');
     outtextxy(0,60,'º _________________________                                        º');
     outtextxy(0,70,'º> |Esc| - EXIT FROM ELI.                                          º');
     outtextxy(0,80,'º                                                                  º');
     outtextxy(0,90,'ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[Enter -> out]ÄÄÄÄÄÄĽ');
     readln;
     setcolor(10);
     end;

procedure sprava(typ:shortint);
          begin
          setcolor(16);
          outtextxy(280,220,'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²');
          setcolor(14);
          case typ of
          0:outtextxy(280,220,'Teraz sa pohybujete realne.');
          1:outtextxy(280,220,'Teraz sa otacate okolo atraktora.');
          end;
          delay(3000);
          setcolor(10);
          end;
procedure lano;
          begin
          P_Pa:=sqrt(sqr(Pa[1]-P[1])+sqr(Pa[2]-P[2])+sqr(Pa[3]-P[3]));
          end;
procedure spinv(zmysel:Shortint);
          var vektor:pole_v;
          pocitadlo:Shortint;
          odchylka:real;
          begin
          if (vektorp[1]+vektorp[2])<>0 then begin
          if cspining<=0 then begin
                              vektorp[1]:=vektorpup[1]*zmysel;
                              vektorp[2]:=vektorpup[2]*zmysel;
                              vektorp[3]:=vektorpup[3]*zmysel;
                              vektorpup[1]:=vektorp[1]*zmysel*(-1);
                              vektorpup[2]:=vektorp[2]*zmysel*(-1);
                              vektorpup[3]:=vektorp[3]*zmysel*(-1);
                              Exit;
                              end;
          vektor[1]:=(vektorpup[1]*zmysel+vektorp[1])*0.707107;
          vektor[2]:=(vektorpup[2]*zmysel+vektorp[2])*0.707107;
          vektor[3]:=(vektorpup[3]*zmysel+vektorp[3])*0.707107;
          if cspining>1 then for pocitadlo:= 2 to cspining do
           begin
           vektor[1]:=(vektor[1]+vektorp[1])/2;
           vektor[2]:=(vektor[2]+vektorp[2])/2;
           vektor[3]:=(vektor[3]+vektorp[3])/2;
           end;
 odchylka:=1/(sqrt(vektor[1]*vektor[1]+vektor[2]*vektor[2]+vektor[3]*vektor[3]));
          vektorp[1]:=vektor[1]*odchylka;
          vektorp[2]:=vektor[2]*odchylka;
          vektorp[3]:=vektor[3]*odchylka;
          vektorpup[1]:=vektorpright[2]*vektorp[3]-vektorp[2]*vektorpright[3];
          vektorpup[2]:=vektorpright[3]*vektorp[1]-vektorp[3]*vektorpright[1];
          vektorpup[3]:=vektorpright[1]*vektorp[2]-vektorp[1]*vektorpright[2];
                               end;
          end;

procedure spinh(zmysel:Shortint);
          var vektor:pole_v;
          pocitadlo:Shortint;
          odchylka:real;
          begin
          if cspining<=0 then cspining:=1;

 if (vektorp[1]+vektorp[2])<>0 then begin
          vektor[1]:=(vektorp[2]*zmysel+vektorp[1])*0.707107;
          vektor[2]:=(-1*vektorp[1]*zmysel+vektorp[2])*0.707107;
          if cspining>1 then for pocitadlo:= 2 to cspining do
           begin
           vektor[1]:=(vektor[1]+vektorp[1])/2;
           vektor[2]:=(vektor[2]+vektorp[2])/2;
           end;
 odchylka:=(sqrt(sqr(vektorp[1])+sqr(vektorp[2])))/(sqrt(sqr(vektor[1])+sqr(vektor[2])));
          vektorp[1]:=vektor[1]*odchylka;
          vektorp[2]:=vektor[2]*odchylka;
                                           end;

          vektor[1]:=(vektorpright[2]*zmysel+vektorpright[1])*0.707107;
          vektor[2]:=(-1*vektorpright[1]*zmysel+vektorpright[2])*0.707107;
          if cspining>1 then for pocitadlo:= 2 to cspining do
           begin
           vektor[1]:=(vektor[1]+vektorpright[1])/2;
           vektor[2]:=(vektor[2]+vektorpright[2])/2;
           end;
 odchylka:=1/(sqrt(sqr(vektor[1])+sqr(vektor[2])));
          vektorpright[1]:=vektor[1]*odchylka;
          vektorpright[2]:=vektor[2]*odchylka;

if (vektorpup[1]+vektorpup[2])<>0 then begin
          vektorpup[1]:=vektorpright[2]*vektorp[3]-vektorp[2]*vektorpright[3];
          vektorpup[2]:=vektorpright[3]*vektorp[1]-vektorp[3]*vektorpright[1];
          vektorpup[3]:=vektorpright[1]*vektorp[2]-vektorp[1]*vektorpright[2];
                                              end;
          end;
procedure movep;
     var {index}i:real;
     begin
     i:=P_Pa/absp;
     P[1]:=(Pa[1]-vektorp[1])*i;
     P[2]:=(Pa[2]-vektorp[2])*i;
     P[3]:=(Pa[3]-vektorp[3])*i;
     end;
procedure d;
     begin
     dp:=-vektorp[1]*P[1]-vektorp[2]*P[2]-vektorp[3]*P[3];
     dright:=-vektorpright[1]*P[1]-vektorpright[2]*P[2]-vektorpright[3]*P[3];
     dup:=-vektorpup[1]*P[1]-vektorpup[2]*P[2]-vektorpup[3]*P[3];
     absp:=sqrt(vektorp[1]*vektorp[1]+vektorp[2]*vektorp[2]+vektorp[3]*vektorp[3]);
     abspright:=sqrt(vektorpright[1]*vektorpright[1]+vektorpright[2]*vektorpright[2]+vektorpright[3]*vektorpright[3]);
     abspup:=sqrt(vektorpup[1]*vektorpup[1]+vektorpup[2]*vektorpup[2]+vektorpup[3]*vektorpup[3]);
     end;

procedure longline(ax,ay,bx,by,l:integer);
     type pole=array[1..2] of integer;
     var u:pole;
     i:real;
     begin
     u[1]:=bx-ax;
     u[2]:=by-ay;
     i:=l/sqrt( sqr(u[1])+sqr(u[2]) );
     u[1]:=round(u[1]*i);
     u[2]:=round(u[2]*i);
     line(ax,ay,ax+u[1],ay+u[2]);
     end;
     {800-900}

procedure px3d(x,y,z:real);
     var i,lp,lpright,lpup:real;
     begin
     lp:=(vektorp[1]*x+vektorp[2]*y+vektorp[3]*z+dp)/absp;
     if lp>0 then begin

     lpright:=(vektorpright[1]*x+vektorpright[2]*y+vektorpright[3]*z+dright)/abspright;
     lpup:=(vektorpup[1]*x+vektorpup[2]*y+vektorpup[3]*z+dup)/abspup;

     i:=monitor/lp;
     line(round(i*lpright)+320,240-round(i*lpup),round(i*lpright)+320,240-round(i*lpup));
                  end;

     end;

procedure line3d(x,y,z,x2,y2,z2:real);
     var i,lpa,lprighta,lpupa,lp,lpright,lpup:real;
         a,b:integer;
         label skok;
     begin
     lpa:=(vektorp[1]*x+vektorp[2]*y+vektorp[3]*z+dp)/absp;
     lprighta:=(vektorpright[1]*x+vektorpright[2]*y+vektorpright[3]*z+dright)/abspright;
     lpupa:=(vektorpup[1]*x+vektorpup[2]*y+vektorpup[3]*z+dup)/abspup;

     lp:=(vektorp[1]*x2+vektorp[2]*y2+vektorp[3]*z2+dp)/absp;
     if lp<0 then if lpa<0 then goto skok;{!SKOK/JUMP}
     lpright:=(vektorpright[1]*x2+vektorpright[2]*y2+vektorpright[3]*z2+dright)/abspright;
     lpup:=(vektorpup[1]*x2+vektorpup[2]*y2+vektorpup[3]*z2+dup)/abspup;

     if lp>0 then if lpa>0 then begin
     {i:=monitor/lp;}
     a:=round((monitor/lpa)*lprighta)+320;
     b:=240-round((monitor/lpa)*lpupa);
     i:=monitor/lp;
     line(a,b,round(i*lpright)+320,240-round(i*lpup));
                                end;
     skok:;                               {!SKOK/JUMP}
     end;

procedure nomoveto3d;
      begin
      moveto_1st:=0;
      end;
procedure moveto3d(x,y,z:real);
      var i,lp,lpright,lpup:real;
      a,b:integer;
      begin
     lp:=(vektorp[1]*x+vektorp[2]*y+vektorp[3]*z+dp)/absp;
     if lp>0 then begin
     lpright:=(vektorpright[1]*x+vektorpright[2]*y+vektorpright[3]*z+dright)/abspright;
     lpup:=(vektorpup[1]*x+vektorpup[2]*y+vektorpup[3]*z+dup)/abspup;
     i:=monitor/lp;
     a:=round(i*lpright)+320;;
     b:=240-round(i*lpup);
     if moveto_1st=0 then begin
                          moveto_point[1]:=a;
                          moveto_point[2]:=b;
                          moveto_1st:=1;
                          exit;
                          end;
     line(moveto_point[1],moveto_point[2],a,b);
                  end;
     moveto_point[1]:=a;
     moveto_point[2]:=b;
     end;

procedure gula3d(sx,sy,sz,r:real);
     var H,V:integer;
     vyska,imgr,x,y:real;
     begin
     if gula.nh>=3500 then gula.nh:=3500;
     if gula.nv>=3500 then gula.nh:=3500;
{     gula.nh:=20;
          gula.nv:=5;
          gula.fii_h[1]:=0;
          gula.fii_h[2]:=gula.nh;
          gula.fii_v[1]:=0;
          gula.fii_v[2]:=gula.nv;
          gula.vektor_g_z[3]:=1;
           gula.vektor_g_x[3]:=0;
            gula.vektor_g_y[1]:=0;         }

     for V:= gula.fii_v[1] to gula.fii_v[2] do begin
      vyska:=cos((Pi/gula.nv)*V)*r+sz;
      imgr:=sin((Pi/gula.nv)*V)*r;
      nomoveto3d;
         for H:=gula.fii_h[1] to gula.fii_h[2] do begin
           y:=sin(((2*Pi)/gula.nh)*H)*imgr+sx;
           x:=cos(((2*Pi)/gula.nh)*H)*imgr+sy;
           moveto3d(x,y,vyska);
           if V=0 then line3d(x,y,vyska,x,y,vyska);
           if V<>0 then line3d(x,y,vyska,obruc[H][1],obruc[H][2],obruc[H][3]);

           obruc[H][1]:=x;
           obruc[H][2]:=y;
           obruc[H][3]:=vyska;

                                                  end;
                            end;
     end;

procedure rotoid(sx,sy,sz,r,v:real);
          var H:integer;
          x,y,vyska:real;
          begin
          nomoveto3d;
          for H:=gula.fii_h[1] to gula.fii_h[2] do begin
           y:=sin(((2*Pi)/gula.nh)*H)*r+sy;
           x:=cos(((2*Pi)/gula.nh)*H)*r+sx;
           vyska:=v+sz;
           moveto3d(x,y,vyska);
           if V=0 then line3d(x,y,vyska,x,y,vyska);
           if V<>0 then line3d(x,y,vyska,obruc[H][1],obruc[H][2],obruc[H][3]);

           obruc[H][1]:=x;
           obruc[H][2]:=y;
           obruc[H][3]:=vyska;

                                                  end;

          end;

procedure longline3d;
     begin end;

{procedure gula(S:pole_v;r:real);
     var I:integer;
     begin

     end;
}
begin
{-[]-}
gd:=detect;
InitGraph(gd, gm, 'c:/bp/bgi');
if GraphResult <> grOk then Halt(1);
{zavedenie premennych}
premenne;
nastavenia;
lano;
d;
{koniec zavaadzania}
{-[]-}
repeat
start: clearviewport;
{telo}

gula3d(0,0,1.5,0.5);
for M:=0 to 190 do begin
rotoid(0,0,0,((cos((PI/40) * M/10+0.01))/(sin((PI/40) * M/10+0.01))),-M);
end;










{/telo}
{->podmienkovy retazec pohybu pozorovatela}
i:=readkey;
if artofmoveing=0 then begin
   case i of
   #32: {navrat puovodnych hodnot}nastavenia;
   #63: {prepnutie pohybu}begin artofmoveing:=1;lano;movep;sprava(1);goto start;end;
   #59: {F1 prva pomoc/Quick help}f1;

   #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);

   #54:begin{doprava/right}
       P[1]:=P[1]+cmoveing*vektorpright[1];
       P[2]:=P[2]+cmoveing*vektorpright[2];
       P[3]:=P[3]+cmoveing*vektorpright[3];
       end;
   #52:begin{dolava/left}
       P[1]:=P[1]-cmoveing*vektorpright[1];
       P[2]:=P[2]-cmoveing*vektorpright[2];
       P[3]:=P[3]-cmoveing*vektorpright[3];
       end;
   #56:begin{hore/up}
       P[1]:=P[1]+cmoveing*vektorpup[1];
       P[2]:=P[2]+cmoveing*vektorpup[2];
       P[3]:=P[3]+cmoveing*vektorpup[3];
       end;
   #50:begin{dole/down}
       P[1]:=P[1]-cmoveing*vektorpup[1];
       P[2]:=P[2]-cmoveing*vektorpup[2];
       P[3]:=P[3]-cmoveing*vektorpup[3];
       end;
   #53,#43:begin{priblizit/zoom in}
           P[1]:=P[1]+cmoveing*vektorp[1];
           P[2]:=P[2]+cmoveing*vektorp[2];
           P[3]:=P[3]+cmoveing*vektorp[3];
           end;
   #47,#45:begin{oddialit/zoom out}
        P[1]:=P[1]-cmoveing*vektorp[1];
        P[2]:=P[2]-cmoveing*vektorp[2];
        P[3]:=P[3]-cmoveing*vektorp[3];
        end;
   end;
                 end;
{zaciatok ineho spuosobu pohybu}
if artofmoveing<>0 then begin
   case i of
   #32: {navrat puovodnych hodnot}nastavenia;
   #63: {prepnutie pohybu}begin artofmoveing:=0;sprava(0);end;
   #59: {F1 prva pomoc/Quick help}f1;


   #54,#77:begin{doprava/right}
           spinh(-1);
           movep;
           end;
   #52,#75:begin{dolava/left}
           spinh(1);
           movep;
           end;
   #56,#72:begin{hore/up}
           spinv(-1);
           movep;
           end;
   #50,#80:begin{dole/down}
           spinv(1);
           movep;
           end;

   #49:begin{dole vlavo/down left}
       spinv(1);
       spinh(1);
       movep;
       end;
   #51:begin{dole vpravo/down right}
       spinv(1);
       spinh(-1);
       movep;
       end;
   #55:begin{hore vlavo/up left}
       spinv(-1);
       spinh(1);
       movep;
       end;
   #57:begin{hore vpravo/up right}
       spinv(-1);
       spinh(-1);
       movep;
       end;

   #53,#43:begin{priblizit/zoom in}
           P[1]:=P[1]+cmoveing*vektorp[1];
           P[2]:=P[2]+cmoveing*vektorp[2];
           P[3]:=P[3]+cmoveing*vektorp[3];
           lano;
           end;
   #45,#47:begin{oddialit/zoom out}
        P[1]:=P[1]-cmoveing*vektorp[1];
        P[2]:=P[2]-cmoveing*vektorp[2];
        P[3]:=P[3]-cmoveing*vektorp[3];
        lano;
        end;
   end;
          end;

d;
{->end}
until i=#27;
 CloseGraph;
end.