3dlines.pas

uses Crt, Graph;

type
  vec2 = array [1..2] of integer;
  vec3 = array [1..3] of real;
  matrix3 = array [1..3,1..3] of real;
  cube = array [1..8] of vec3;
const
  cubeex : cube = ((-1,1,1),(1,1,1),(-1,-1,1),(1,-1,1),(-1,1,-1),(1,1,-1),(1,-1,-1),(-1,-1,-1));
  scale: real = 100.0;

var
  Gd, Gm, i, j : integer;
  a,b,c : real;
  cubetrans : cube;
  transmatrix : matrix3;
  respoints : array [1..8] of vec2;

procedure matrixmult(a, b: matrix3; var mul: matrix3);
  var
    i, j, k : integer;
  begin
    for i := 1 to 3 do
    for j := 1 to 3 do
      begin
        mul[i,j] := 0;
        for k:=1 to 3 do
          mul[i,j] :=mul[i,j]+a[i,k]*b[k,j];
      end;
  end;

procedure matrixvectormult(a: matrix3; b: vec3; var c: vec3);
  var
    i : integer;
  begin
    for i := 1 to 3 do
      c[i] := a[i,1]*b[1] + a[i,2]*b[2] + a[i,3]*b[3];
  end;

procedure rotationmatrix(a, b, c: real; var d: matrix3);
  var
    e,f,g,t : matrix3;
    s,k : real;
    i,j : integer;
  begin
    for i := 1 to 3 do
    for j := 1 to 3 do
      begin
        e[i,j] := 0;
        f[i,j] := 0;
        g[i,j] := 0;
      end;
    e[1,1] := 1;
    f[2,2] := 1;
    g[3,3] := 1;
    s := sin(a);
    k := cos(a);
    e[2,2] := k;
    e[2,3] := -s;
    e[3,2] := s;
    e[3,3] := k;
    s := sin(b);
    k := cos(b);
    f[1,1] := k;
    f[1,3] := s;
    f[3,1] := -s;
    f[3,3] := k;
    s := sin(c);
    k := cos(c);
    g[1,1] := k;
    g[1,2] := -s;
    g[2,1] := s;
    g[2,2] := k;
    matrixmult(e,f,t);
    matrixmult(t,g,d);
  end;

procedure projectvector(a: vec3; var b: vec2);
  var
    c: real;
  begin
    c := (1 - a[3]/3) / scale;
    b[1] := round(a[1]/c) + 320;
    b[2] := round(a[2]/c) + 240;
  end;

begin
  Gd := Detect;
  InitGraph(Gd, Gm, 'C:\');
  if GraphResult <> grOk then
  Halt(1);
  Randomize;
  a := 0;
  b := 0;
  c := 0;
  repeat
    ClearDevice;
    rotationmatrix(a,b,c,transmatrix);
    for i := 1 to 8 do
      begin
        matrixvectormult(transmatrix, cubeex[i], cubetrans[i]);
        projectvector(cubetrans[i], respoints[i]);
      end;
    for i := 1 to 7 do
      begin
        Line(respoints[i,1], respoints[i,2], respoints[i+1,1], respoints[i+1,2]);
      end;
    a := a + 0.01;
    b := b + 0.01;
  until KeyPressed;
  CloseGraph;
end.