{ *** MOV 3D ***     Versione 1.00
  Simulazione del movimento di oggetti 3D
  Scritto da Trocchi Roberto - 25/11/1990
  Castel San Pietro Terme , Bologna , Italy.
  ------------------------------------------------------------------------------
  ***********
  * DEMO 3D *   
  ***********
  Tempo di calcolo su AT 20 MHz senza 80287 circa 2' 30".
}

PROGRAM demo;

CONST
  x=0;
  R=1;
  h=0.2;
  dh=0.523598;
  ds=0.5236;

VAR
  FLOAT:B;
  INTEGER:n;
  POINT: P1,P2,P3,P4,P5,P6;
  FACE: F;
  OBJECT: cubo,assex,assey,elica,cilindro,cono,semisfera;

lib demo;

function param(float: fi): point;
  param:=(R*sin(fi),R*cos(fi),h*fi);

BEGIN
  InitGraph(0,0);  

  cubo:=( (0,0,0) ,
          (0,0,0) , (0,0,0) , 0 ,
          1 ,
          (
            ( (0,0,0) , (1,0,0) , (0,1,0) , 2 , (15,15,15) )
            ( (1,1,0) , (1,0,0) , (0,1,0) , 4 , (15,15,15) )
            ( (0,0,0) , (0,1,0) , (0,1,1) , 5 , (15,15,15) )
            ( (0,0,0) , (0,0,1) , (0,1,1) , 3 , (15,15,15) )
            ( (0,0,0) , (1,0,0) , (1,0,1) , 14 , (15,15,15) )
            ( (0,0,0) , (1,0,1) , (0,0,1) , 1 , (15,15,15) )
            ( (1,0,0) , (1,1,0) , (1,1,1) , 4 , (15,15,15) )
            ( (1,0,0) , (1,0,1) , (1,1,1) , 5 , (15,15,15) )
            ( (1,1,0) , (0,1,0) , (0,1,1) , 3 , (15,15,15) )
            ( (1,1,0) , (1,1,1) , (0,1,1) , 14 , (15,15,15) )
          )
        );
  assex:=( (0,0,1) ,
           (0,0,0) , (0,0,0) , 0 ,
           1 ,
           (
             ( (0,0,0) , (-1,0.25,0) , (-1,-0.25,0) , 14 , (15,15,15) )
           )
         );
  assey:=( (0,0,1) ,
           (0,0,0) , (0,0,0) , 0 ,
           1 ,
           (
             ( (0,0,0) , (0.25,-1,0) , (-0.25,-1,0) , 11 , (15,15,15) )
           )
         );

  elica:=( (2,2,0) ,
           (0,0,0) , (0,0,0) , 0 ,
           1 ,
           (
             ( (0,0,0) , (0,0,0) , (0,0,0) , 0 , (0,0,0) )
           )
         );
  b:=-2*PI;
  while b[2*PI do
  begin
    p1:=param(b);
    p2:=param(b+dh);
    f:=( p1 , p2 , (0,0,getc(p1,3)) , trunc(15*random)+1 , (15,15,15) );
    addface(elica,f);
    b:=b+dh;
  end;

  cilindro:=( (4,0,0) ,
              (0,0,0) , (0,0,0) , 0 ,
              1 ,
              (
                ( (0,0,0) , (0,0,0) , (0,0,0) , 0 , (0,0,0) )
              )
            );
  b:=0;
  while b<2*PI do
  begin
    p1:=(sin(b),cos(b),-1);
    p2:=(sin(b+ds),cos(b+ds),-1);
    p3:=p1;
    p4:=p2;
    setc(p3,3,1);
    setc(p4,3,1);
    f:=( p1,p2,p3,trunc(15*random)+1,(15,15,15) );
    addface(cilindro,f);
    f:=( p2,p3,p4,trunc(15*random)+1,(15,15,15) );
    addface(cilindro,f);
    b:=b+ds;
  end;

  cono:=( (0,4,0) ,
          (0,0,0) , (0,0,0) , 0 ,
          1 ,
          (
            ( (0,0,0) , (0,0,0) , (0,0,0) , 0 , (0,0,0) )
          )
        );
  b:=0;
  while b<2*PI do
  begin
    p1:=(sin(b),cos(b),1);
    p2:=(sin(b+ds),cos(b+ds),1);
    f:=( p1,p2,(0,0,-1),trunc(15*random)+1,(15,15,15) );
    addface(cono,f);
    b:=b+ds;
  end;

  semisfera:=( (4,4,0) ,
               (0,0,0) , (0,0,0) , 0 ,
               1 ,
               (
                 ( (0,0,0) , (0,0,0) , (0,0,0) , 0 , (0,0,0) )
               )
             );
  b:=0;
  while b<2*PI do
  begin
    p1:=(b,0,R);
    p2:=(b+ds,0,R);
    p3:=(b,PI/6,R);
    p4:=(b+ds,PI/6,R);
    p5:=(b,PI/3,R);
    p6:=(b+ds,PI/3,R);
    p1:=polcart(p1);
    p2:=polcart(p2);
    p3:=polcart(p3);
    p4:=polcart(p4);
    p5:=polcart(p5);
    p6:=polcart(p6);

    f:=( p1,p2,p4,trunc(15*random)+1,(15,15,15) );
    addface(semisfera,f);
    f:=( p1,p3,p4,trunc(15*random)+1,(15,15,15) );
    addface(semisfera,f);
    f:=( p6,p3,p4,trunc(15*random)+1,(15,15,15) );
    addface(semisfera,f);
    f:=( p6,p3,p5,trunc(15*random)+1,(15,15,15) );
    addface(semisfera,f);
    f:=( p5,p6,(0,0,R),trunc(15*random)+1,(15,15,15) );
    addface(semisfera,f);

    b:=b+ds;
  end;


  p1:=(1.5,1,0);
  setlookat(p1);

  b:=0;
  while b[(2*PI+PI/2) do
  begin
    p1:=(b,PI/6*cos(b),50);
    b:=b+0.3;
    p2:=PolCart(p1);
    SetObsLoc(p2);
    Draw;
    pause(x);
  end;

END.