{

Three-D Cube Demo.

Written in 1996 by Alon Altman.

Please send any replies to alona@usa.net

Visit my website at http://members.tripod.com/~alona/

---

Available keys:

0: Reset View
*: Reset Cube

9: Set current dot as center (x0,y0,z0)

[: Save current view
]: Return to saved
\: Animate to saved

l,;,': Animate rotation

/: Next Dot
?: Previous dot

1: Increase X0 by 25
q: Decrease X0 by 25
2: Increase Y0 by 25
w: Decrease Y0 by 25
3: Increase Z0 by 25
e: Decrease Z0 by 25
4: Increase alpha by pi/30
r: Decrease alpha by pi/30
5: Increase beta by pi/30
t: Decrease beta by pi/30

6: Increase current dot's X
y: Decrease current dot's X
7: Increase current dot's Y
u: Decrease current dot's Y
8: Increase current dot's Z
i: Decrease current dot's Z

!: Rotate cube axis 1 direction 1 by pi/30
Q: Rotate cube axis 1 direction 2 by pi/30
@: Rotate cube axis 2 direction 1 by pi/30
W: Rotate cube axis 2 direction 2 by pi/30
#: Rotate cube axis 3 direction 1 by pi/30
E: Rotate cube axis 3 direction 2 by pi/30

A: Rotate cube axis 1 direction 1 by pi/150
Z: Rotate cube axis 1 direction 2 by pi/150
S: Rotate cube axis 2 direction 1 by pi/150
X: Rotate cube axis 2 direction 2 by pi/150
D: Rotate cube axis 3 direction 1 by pi/150
C: Rotate cube axis 3 direction 2 by pi/150

[For more keys look at this source]

}
program threed;
uses crt,graph,graphsub;

{$R-}

const biga=pi/30; smla=pi/150;

type real_=extended;
     p2d=^dot2d;
     dot2d = record
               x,y:real_;
             end;

     p3d = record
             x,y,z:real_;
           end;

type viewsettings = ^viewsettings_;
     viewsettings_= object
                      prevz:real_;
                      function find(p:p3d):p2d; virtual;
                      procedure update; virtual;
                    end;

type paraview = ^paraview_;
     paraview_ =    object(viewsettings_)
                      x0,y0,z0,x2,y2,alpha,beta:real_;
                      function find(p:p3d):p2d; virtual;
                      procedure update; virtual;
                      constructor init(_x0,_y0,_z0,_alpha,_beta,_x2,_y2:real_);
                      constructor copy(v:paraview);
                    end;

     perspview = ^perspview_;
     perspview_ = object(viewsettings_)
                    zoom:word;
                    function find(p:p3d):p2d; virtual;
                    procedure update; virtual;
                    constructor init(_zoom:word);
                    constructor copy(v:perspview);
                  end;

     cube = object
              dots:array[1..8] of p3d;
              d:array[1..8] of p2d;
              pd:byte;
              procedure setx(i:byte;n:real_);
              procedure sety(i:byte;n:real_);
              procedure setz(i:byte;n:real_);
              procedure erase;
              procedure draw(view:viewsettings);
              constructor init(x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,x5,y5,z5,
                               x6,y6,z6,x7,y7,z7,x8,y8,z8:real_);
            end;
{
     tddp = ^tdd;
     tdvp = ^tdv;
     tdsp = ^tds;

     tdd = object
             x,y,z:real_;
             links:array[1..16] of tdvp;
             procedure setx(n:real_);
             procedure sety(n:real_);
             procedure setz(n:real_);
             procedure addlink(d:tddp);
             procedure dellink(d:tddp);
           end;

     tdv = object
             d1,d2:tddp;
             procedure draw(view:viewsettings;c:byte);
             constructor init(_d1,_d2:tddp);
           end;

     tds = object
             dot:tddp;
             pv:viewsettings;
             procedure erase;
             procedure draw(view:viewsettings);
             constructor init(d:tddp);
           end;
}
function perspview_.find;
  var o:p2d;
  begin
    new(o);
    o^.x:=arctan(p.x/p.z)*zoom;
    o^.y:=arctan(p.y/p.z)*zoom;
    find:=o;
  end;

procedure perspview_.update;
  begin
    gotoxy(1,1);
    textattr:=$0b;
    write('ZOOM: ',zoom);
  end;

constructor paraview_.init;
  begin
    x0:=_x0; y0:=_y0; z0:=_z0; alpha:=_alpha; beta:=_beta; x2:=_x2; y2:=_y2;
  end;

constructor perspview_.init;
  begin
    zoom:=_zoom;
  end;

constructor perspview_.copy;
  begin
    zoom:=v^.zoom;
  end;

constructor paraview_.copy;
  begin
    x0:=v^.x0; y0:=v^.y0; z0:=v^.z0; alpha:=v^.alpha; beta:=v^.beta; x2:=v^.x2; y2:=v^.y2;
  end;

constructor cube.init;
  begin
    dots[1].x:=x1; dots[1].y:=y1; dots[1].z:=z1;
    dots[2].x:=x2; dots[2].y:=y2; dots[2].z:=z2;
    dots[3].x:=x3; dots[3].y:=y3; dots[3].z:=z3;
    dots[4].x:=x4; dots[4].y:=y4; dots[4].z:=z4;
    dots[5].x:=x5; dots[5].y:=y5; dots[5].z:=z5;
    dots[6].x:=x6; dots[6].y:=y6; dots[6].z:=z6;
    dots[7].x:=x7; dots[7].y:=y7; dots[7].z:=z7;
    dots[8].x:=x8; dots[8].y:=y8; dots[8].z:=z8;
  end;

procedure cube.setx;
  begin
    dots[i].x:=n;
  end;

procedure cube.sety;
  begin
    dots[i].y:=n;
  end;

procedure cube.setz;
  begin
    dots[i].z:=n;
  end;

function viewsettings_.find;
  begin
  end;

procedure viewsettings_.update;
  begin
  end;

function paraview_.find(p:p3d):p2d;
  var o:p2d;
      pp:p3d;
  begin
    pp:=p;
    with p do begin
      x:=x-x0;
      y:=y-y0;
      z:=z-z0;
      pp.x:=x*sin(beta)+y*cos(beta);
      y:=x*cos(beta)-y*sin(beta);
      x:=pp.x*sin(alpha)+z*cos(alpha);
      z:=pp.x*cos(alpha)-z*sin(alpha);
      x:=x+x0; y:=y+y0; z:=z+z0;
      prevz:=z;
      new(o);
      o^.x:=x+x2;
      o^.y:=y+y2;
      find:=o;
    end;
  end;

procedure paraview_.update;
  begin
    gotoxy(1,1);
    textattr:=$0b;
    write('X0: ',x0:1:0,', Y0: ',y0:1:0,', Z0: ',z0:1:0,', à:',alpha:1:2,', á:',beta:1:2);
  end;

procedure p(d:p2d);
  begin
    writeln('(',d^.x:4:2,',',d^.y:4:2,')');
  end;

procedure x(d:p2d;c:byte);
  var x,y:integer;
  begin
    x:=round(d^.x); y:=round(d^.y);
    setcolor(c);
    rectangle(x-2,y-2,x+2,y+2);
  end;

procedure l(d1,d2:p2d);
  var x1,y1,x2,y2:word;
  begin
    x1:=round(d1^.x); y1:=round(d1^.y);
    x2:=round(d2^.x); y2:=round(d2^.y);
    line(x1,y1,x2,y2);
  end;

var cub:cube;
    i,j:byte;
    xt,yt:real_;
    view,sv,dv: paraview{perspview};
    c:char;
    dot:byte;

procedure cube.draw;
  const cubedef: array[1..8,1..3] of byte =
        ((2,3,5),(1,4,6),(1,4,7),(2,3,8),(1,6,7),(2,5,8),(3,5,8),(4,6,7));
  var i,j,zmi:byte;
      zmax:real_;
  begin
    zmax:=-maxint;
    with view^ do for i:=1 to 8 do begin
      d[i]:=find(dots[i]);
      if prevz>zmax then begin
        zmax:=prevz;
        zmi:=i;
      end;
    end;
    setcolor(8);
    for j:=1 to 3 do l(d[zmi],d[cubedef[zmi,j]]);
    setcolor(15);
    for i:=1 to 8 do if i<>zmi then
      for j:=1 to 3 do if cubedef[i,j]<>zmi then l(d[i],d[cubedef[i,j]]);
    x(d[dot],12);
    pd:=dot;
    view^.update;
    view^.find(dots[dot]);
    write(', X:',dots[dot].x:1:0,', Y:',dots[dot].y:1:0,', Z:',dots[dot].z:1:0,', DOTZ:',view^.prevz:1:0);
    textattr:=$00;
    clreol;
  end;

procedure cube.erase;
  begin
    setcolor(0);
    l(d[4],d[8]);
    l(d[6],d[8]);
    l(d[7],d[8]);
    {---}
    l(d[1],d[5]);
    l(d[2],d[6]);
    l(d[3],d[7]);
    {---}
    l(d[1],d[3]);
    l(d[2],d[4]);
    l(d[5],d[7]);
    {---}
    l(d[1],d[2]);
    l(d[3],d[4]);
    l(d[5],d[6]);
    {---}
    x(d[pd],0);    for i:=1 to 8 do dispose(d[i]);
  end;

begin  clrscr;
  directvideo:=false;
  init;
  cub.init (100,100,100,100,100,200,100,200,100,100,200,200,
            200,100,100,200,100,200,200,200,100,200,200,200);
  new(view,init(0,0,0,0,0,0,0));
  new(sv,init(0,0,0,0,0,0,0));
  new(dv,init(0,0,0,0,0,0,0));
{ new(view,init(300));}
  dot:=1;
  repeat
    cub.draw(view);
    c:=readkey;
    with view^ do case c of
      '0':view^.init( 0,0,0,0,0{300},0,0);
      '*':cub.init (100,100,100,100,100,200,100,200,100,100,200,200,
                    200,100,100,200,100,200,200,200,100,200,200,200);
      '1': x0:=x0+25{inc(zoom,25)};
      'q': x0:=x0-25{dec(zoom,25)};
      '2':y0:=y0+25;
      'w':y0:=y0-25;
      '3':z0:=z0+25;
      'e':z0:=z0-25;
      '4':alpha:=alpha+biga;
      'r':alpha:=alpha-biga;
      '5':beta:=beta+biga;
      't':beta:=beta-biga;
      '6':cub.setx(dot,cub.dots[dot].x+25);
      'y':cub.setx(dot,cub.dots[dot].x-25);
      '7':cub.sety(dot,cub.dots[dot].y+25);
      'u':cub.sety(dot,cub.dots[dot].y-25);
      '8':cub.setz(dot,cub.dots[dot].z+25);
      'i':cub.setz(dot,cub.dots[dot].z-25);
      '!':for i:=1 to 8 do begin
            xt:=cub.dots[i].x-150;
            yt:=cub.dots[i].y-150;
            cub.sety(i,150+xt*sin(biga)+yt*cos(biga));
            cub.setx(i,150+xt*cos(biga)-yt*sin(biga));
          end;
      'Q':for i:=1 to 8 do begin
            xt:=cub.dots[i].x-150;
            yt:=cub.dots[i].y-150;
            cub.sety(i,150+xt*sin(-biga)+yt*cos(-biga));
            cub.setx(i,150+xt*cos(-biga)-yt*sin(-biga));
          end;
      'A':for i:=1 to 8 do begin
            xt:=cub.dots[i].x-150;
            yt:=cub.dots[i].y-150;
            cub.sety(i,150+xt*sin(smla)+yt*cos(smla));
            cub.setx(i,150+xt*cos(smla)-yt*sin(smla));
          end;
      'Z':for i:=1 to 8 do begin
            xt:=cub.dots[i].x-150;
            yt:=cub.dots[i].y-150;
            cub.sety(i,150+xt*sin(-smla)+yt*cos(-smla));
            cub.setx(i,150+xt*cos(-smla)-yt*sin(-smla));
          end;
      '@':for i:=1 to 8 do begin
            xt:=cub.dots[i].x-150;
            yt:=cub.dots[i].z-150;
            cub.setz(i,150+xt*sin(biga)+yt*cos(biga));
            cub.setx(i,150+xt*cos(biga)-yt*sin(biga));
          end;
      'W':for i:=1 to 8 do begin
            xt:=cub.dots[i].x-150;
            yt:=cub.dots[i].z-150;
            cub.setz(i,150+xt*sin(-biga)+yt*cos(-biga));
            cub.setx(i,150+xt*cos(-biga)-yt*sin(-biga));
          end;
      'S':for i:=1 to 8 do begin
            xt:=cub.dots[i].x-150;
            yt:=cub.dots[i].z-150;
            cub.setz(i,150+xt*sin(smla)+yt*cos(smla));
            cub.setx(i,150+xt*cos(smla)-yt*sin(smla));
          end;
      'X':for i:=1 to 8 do begin
            xt:=cub.dots[i].x-150;
            yt:=cub.dots[i].z-150;
            cub.setz(i,150+xt*sin(-smla)+yt*cos(-smla));
            cub.setx(i,150+xt*cos(-smla)-yt*sin(-smla));
          end;
      '#':for i:=1 to 8 do begin
            xt:=cub.dots[i].y-150;
            yt:=cub.dots[i].z-150;
            cub.setz(i,150+xt*sin(biga)+yt*cos(biga));
            cub.sety(i,150+xt*cos(biga)-yt*sin(biga));
          end;
      'E':for i:=1 to 8 do begin
            xt:=cub.dots[i].y-150;
            yt:=cub.dots[i].z-150;
            cub.setz(i,150+xt*sin(-biga)+yt*cos(-biga));
            cub.sety(i,150+xt*cos(-biga)-yt*sin(-biga));
          end;
      'D':for i:=1 to 8 do begin
            xt:=cub.dots[i].y-150;
            yt:=cub.dots[i].z-150;
            cub.setz(i,150+xt*sin(smla)+yt*cos(smla));
            cub.sety(i,150+xt*cos(smla)-yt*sin(smla));
          end;
      'C':for i:=1 to 8 do begin
            xt:=cub.dots[i].y-150;
            yt:=cub.dots[i].z-150;
            cub.setz(i,150+xt*sin(-smla)+yt*cos(-smla));
            cub.sety(i,150+xt*cos(-smla)-yt*sin(-smla));
          end;
      '^':x2:=x2+25{inc(zoom,25)};
      'Y':x2:=x2-25{dec(zoom,25)};
      'H':x2:=x2+10{inc(zoom,25)};
      'N':x2:=x2-10{dec(zoom,25)};
      '&':y2:=y2+25;
      'U':y2:=y2-25;
      'J':y2:=y2+10;
      'M':y2:=y2-10;
      '9':begin
            x0:=cub.dots[dot].x;
            y0:=cub.dots[dot].y;
            z0:=cub.dots[dot].z;
          end;
      'a':x0:=x0+250;{inc(zoom,5);}
      'z':x0:=x0-250;{dec(zoom,5);}
      's':y0:=y0+250;
      'x':y0:=y0-250;
      'd':z0:=z0+250;
      'c':z0:=z0-250;
      'f':alpha:=alpha+smla;
      'v':alpha:=alpha-smla;
      'g':beta:=beta+smla;
      'b':beta:=beta-smla;
      'h':cub.setx(dot,cub.dots[dot].x+2.5);
      'n':cub.setx(dot,cub.dots[dot].x-2.5);
      'j':cub.sety(dot,cub.dots[dot].y+2.5);
      'm':cub.sety(dot,cub.dots[dot].y-2.5);
      'k':cub.setz(dot,cub.dots[dot].z+2.5);
      ',':cub.setz(dot,cub.dots[dot].z-2.5);
      '[':sv^.copy(view);
      ']':view^.copy(sv);
      '\':begin
          dv^.x0:=(view^.x0-sv^.x0) / 100;
          dv^.y0:=(view^.y0-sv^.y0) / 100;
          dv^.z0:=(view^.z0-sv^.z0) / 100;
          dv^.alpha:=(view^.alpha-sv^.alpha) / 100;
          dv^.beta:=(view^.beta-sv^.beta) / 100;
          view^.copy(sv);
          for j:=1 to 100 do begin
            cub.erase;
            cub.draw(view);
            x0:=x0+dv^.x0;
            y0:=y0+dv^.y0;
            z0:=z0+dv^.z0;
            alpha:=alpha+dv^.alpha;
            beta:=beta+dv^.beta;
          end;
        end;
      'l':
        for j:=1 to 100 do begin
          for i:=1 to 8 do begin
            xt:=cub.dots[i].x-150;
            yt:=cub.dots[i].y-150;
            cub.sety(i,150+xt*sin(pi/50)+yt*cos(pi/50));
            cub.setx(i,150+xt*cos(pi/50)-yt*sin(pi/50));
          end;
          cub.erase;
          cub.draw(view);
        end;
      ';':
        for j:=1 to 100 do begin
          for i:=1 to 8 do begin
            xt:=cub.dots[i].x-150;
            yt:=cub.dots[i].z-150;
            cub.setz(i,150+xt*sin(pi/50)+yt*cos(pi/50));
            cub.setx(i,150+xt*cos(pi/50)-yt*sin(pi/50));
          end;
          cub.erase;
          cub.draw(view);
        end;
      '''':
        for j:=1 to 100 do begin
          for i:=1 to 8 do begin
            xt:=cub.dots[i].y-150;
            yt:=cub.dots[i].z-150;
            cub.setz(i,150+xt*sin(pi/50)+yt*cos(pi/50));
            cub.sety(i,150+xt*cos(pi/50)-yt*sin(pi/50));
          end;
          cub.erase;
          cub.draw(view);
        end;
      '/':begin inc(dot); if dot=9 then dot:=1; end;
      '?':begin dec(dot); if dot=0 then dot:=8; end;
    end;
    cub.erase;
  until c=#27;
  closegraph;
end.