[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

{
I hope you can do something With these listings
I downloaded from a BBS near me....
This File contains:  Program VGA3d
                     Unit DDFigs
                     Unit DDVars
                     Unit DDVideo
                     Unit DDProcs
Just break it in pieces on the cut here signs......

if you need some Units or Programs (or TxtFiles) on Programming the Adlib/
Sound-Blaster or Roland MPU-401, just let me know, and i see if i can dig
up some good listings.....
But , will your game also have Soundblaster/adlib fm support and Sound
Blaster Digitized Sound support, maybe even MPU/MT32? support....
And try to make it as bloody as you can (Heads exploding etc..)(JOKE)

I hope i you can complete your game (i haven't completed any of my games yet)
And i like a copy of it when it's ready......

Please leave a message if you received this File.

  Andre Jakobs
    MicroBrain Technologies Inc.
        GelderlandLaan 9
          5691 KL   Son en Breugel
            The Netherlands............
}


Program animatie_van_3d_vector_grafics;

Uses
  Crt,
  ddvideo,
  ddfigs,
  ddprocs,
  ddVars;

Var
  Opal : paletteType;

Procedure wireframe(pro : vertex2Array);
{ Teken een lijnen diagram van gesloten voorwerpen met vlakken }
Var
  i, j, k,
  v1, v2  : Integer;
begin
  For i :=  1 to ntf DO
  begin
    j := nfac[i];
    if j <> 0 then
    begin
      v1 := faclist[ facfront[j] + size[j] ];
      For k :=  1 to size[j] DO
      begin
        v2 := faclist[facfront[j] + k];
        if (v1<v2) or (super[i] <> 0 ) then
          linepto(colour[j], pro[v1], pro[v2])
        v1 := v2;
      end;
    end;
  end;
end;

Procedure hidden(pro : vertex2Array);
{ Display van Objecten als geheel van de projectiepunten van pro }
{ b is een masker voor de kleuren }
Var
  i,  col : Integer;

  Function signe( n : Real) : Integer;
  begin
    if n >0 then
      signe := -1
    else
    if n <0 then
      signe := 1
    else
      signe := 0;
  end;

  Function orient(f : Integer; v : vertex2Array) : Integer;
  Var
    i, ind1,
    ind2, ind3 : Integer;
    dv1, dv2   : vector2;
  begin
    i := nfac[f];
    if i = 0 then
      orient := 0
    else
    begin
      ind1   := faclist[facfront[i] + 1];
      ind2   := faclist[facfront[i] + 2];
      ind3   := faclist[facfront[i] + 3];
      dv1.x  := v[ind2].x - v[ind1].x;
      dv1.y  := v[ind2].y - v[ind1].y;
      dv2.x  := v[ind3].x - v[ind2].x;
      dv2.y  := v[ind3].y - v[ind2].y;
      orient := signe(dv1.x * dv2.y - dv2.x * dv1.y);
    end;
  end;

  Procedure facetfill(k : Integer);
  Var
    v           : vector2Array;
    i, index, j : Integer;
  begin
    j := nfac[k];
    For i :=  1 to size[j] DO
    begin
      index := faclist[facfront[j] + i];
      v[i]  := pro[index];
    end;
    fillpoly(colour[k], size[j], v);
    polydraw(colour[k] - 1, size[j], v);
  end;

  Procedure seefacet(k : Integer);
  Var
    ipt, supk : Integer;
  begin
    facetfill(k);
    ipt := firstsup[k];
    While ipt <> 0 DO
    begin
      supk := facetinfacet[ipt].info;
       facetfill(supk);
      ipt := facetinfacet[ipt].Pointer;
    end;
  end;

{ hidden Programmacode }
begin
  For i := 1 to nof DO
  if super[i] = 0 then
    if orient(i, pro) = 1 then
      seefacet(i);
end;

Procedure display;
Var
  i : Integer;
begin
  {observe}
  For i := 1 to nov DO
    transform(act[i], Q, obs[i]);

  {project}
  ntv := nov;
  ntf := nof;
  For i := 1 to ntv DO
  begin
    pro[i].x := obs[i].x;
    pro[i].y := obs[i].y;
  end;

  {drawit}
  switch := switch xor 1;
  hidden(pro);
  Scherm_actief(switch);
  Virscherm_actief(switch xor 1);
  wisscherm(prevpoints, $a000, $8a00);
  wis_hline(prevhline, $8a00);
  prevpoints := points;prevhline := hline;
  points[0]  := 0;
  hline[0]   := 0;
end;

Procedure anim3d;
Var
  A, B, C, D, E, F,
  G, H, I, J, QE, P    : matrix4x4;
  zoom, inz, inzplus   : Real;
  angle, angleinc,
  beta, betainc, frame : Integer;
  huidigpalette        : paletteType;

  { Kubus Animatie : Roterende kubus }
  Procedure kubus;
  begin
    angle    := 0;
    angleinc := 9;
    beta     := 0;
    betainc  := 2;
    direct.x := 9;
    direct.y := 2;
    direct.z := -3;
    findQ;
    cubesetup(104);
    frame := 0;

    While (NOT (KeyPressed)) and (frame < 91) do
    begin
      frame   := frame + 1;
      xyscale := zoom * 2 * sinus(beta);
      rot3(1, trunc(angle/2), Qe);
      rot3(2, angle, P);
      mult3(P, Qe, P);
      cube(P);
      display;
      angle := angle + angleinc;
      beta  := beta + betainc;
      nov   := 0;
    end;
  end;

  {Piramides Animatie : Scene opgebouwd uit twee Piramides en 1 Kubus }
  Procedure Piramides;
  begin
    frame   := 0;
    angle   := 0;
    beta    := 0;
    betainc := 2;
    scale3(4.0, 0.2, 4.0, C);
    cubesetup(90);
    cube(P);

    scale3(2.5, 4.0, 2.5, D);
    tran3(2.0, -0.2, 2.0, E);
    mult3(E, D, F);
    pirasetup(34);
    piramid(P);

    scale3(2.0, 4.0, 2.0, G);
    tran3(-3.0, -0.2, 0.0, H);
    mult3(H, G, I);
    pirasetup(42);
    piramid(P);

    E := Q;
    nov := 0;

    While (NOT (KeyPressed)) and (frame < 18) do
    begin
      frame   := frame + 1;
      xyscale := zoom * 2 * sinus(beta);

      rot3(2, angle, B);

      mult3(B, C, P);
      cube(P);

      mult3(B, F, P);
      piramid(P);

      mult3(B, I, P);
      piramid(P);

      display;

      angle := angle + angleinc;
      beta  := beta + betainc;
      nov   := 0;
     end;

     frame := 0;
     angleinc := 7;

     While (NOT (KeyPressed)) and (frame < 75) do
     begin
       frame := frame + 1;

       rot3(2, angle, B);

       mult3(B, C, P);
       cube(P);

       mult3(B, F, P);
       piramid(P);

       mult3(B, I, P);
       piramid(P);

       display;

       angle := angle + angleinc;
       nov   := 0;
     end;

     frame := 0;
     beta := 180-beta;

     While (NOT (KeyPressed)) and (frame < 19) do
     begin

       frame := frame + 1;

       xyscale := zoom * 2 * sinus(beta);
       rot3(2, angle, B);

       mult3(C, B, P);
       cube(P);

       mult3(B, F, P);
       piramid(P);

       mult3(B, I, P);
       piramid(P);

       display;

       angle := angle + angleinc;
       beta  := beta  + betainc;
       nov   := 0;
    end;
  end;

  { Huis_animatie4 : Figuur huis roteert en "komt uit de lucht vallen" }
  Procedure huisval;
  begin
    xyscale  := zoom;
    nof      := 0;
    nov      := 0;
    last     := 0;
    angle    := 1355;
    angleinc := -7;
    frame    := 0;

    huissetup;

    zoom     := 0.02;
    Direct.x := 30;
    direct.y := -2;
    direct.z := 30;
    findQ;

    While (NOT (KeyPressed)) and (frame < 40) do
    begin
      frame := frame + 1;
      zoom  := zoom + 0.01;
      Scale3(zoom, zoom, zoom, Qe);
      tran3(0, (-7 / zoom) + frame / 1.8, 0, A);
      mult3(Qe, A, C);
      rot3(2, angle, B);
      mult3(C, B, P);
      huis(P);
      display;
      angle := angle + angleinc;
      nov   := 0;
    end;

    frame   := 0;
    beta    := angle;
    betainc := angleinc;

    While (NOT (KeyPressed)) and (frame < 15) do
    begin
      frame := frame + 1;

      rot3(2, beta, B);
      mult3(B, Qe, P);
      mult3(P, A, P);
      huis(P);

      display;

      beta    := beta + betainc;
      betainc := trunc(betainc + (7 / 15));
      nov     := 0;
    end;

    frame := 0;

    While (NOT (KeyPressed)) and (frame < 30) do
    begin
      frame    := frame + 1;
      direct.z := direct.z - (frame * (20 / 70));
      findQ;
      huis(P);
      display;
      nov := 0;
    end;

    frame := 0;
    zoom  := 1;

    While (NOT (KeyPressed)) and (frame < 31) do
    begin
      frame := frame + 1;
      mult3(B, Qe, P);
      scale3(zoom, zoom, zoom, C);
      mult3(P, A, P);
      mult3(P, C, P);
      huis(P);
      display;
      zoom := zoom - 1 / 30;
      nov  := 0;
    end;

    zoom := xyscale;
  end;

  { Ster Animatie : Roterende ster als kubus met 4 piramides }
  Procedure Sterrot;
  begin
    xyscale  := zoom;
    frame    := 0;
    angle    := 0;
    angleinc := 9;
    beta     := 0;
    betainc  := 2;
    nof      := 0;
    last     := 0;
    nov      := 0;

    stersetup(140);
    scale3(0, 0, 0, P);
    ster(P, 4);

    Direct.x := 30;
    direct.y := -2;
    direct.z := 30;
    findQ;
    E := Q;

    While (NOT (KeyPressed)) and (frame < 90) do
    begin
      frame   := frame + 1;
      xyscale := zoom * 1.7 * sinus(beta);
      rot3(1, Round(angle/5), A);
      mult3(A, E, Q);
      rot3(2, angle, P);
      ster(P, 4);
      display;
      angle := angle + angleinc;
      beta  := beta  + betainc;
      nov   := 0;
    end;
  end;

begin
  eye.x := 0;
  eye.y := 0;
  eye.z :=  0;
  zoom  := xyscale;
  Repeat
    nov  := 0;
    nof  := 0;
    last := 0;
    Kubus;
    Piramides;
    Huisval;
    Sterrot;
  Until KeyPressed;
end;

{ _______________Hoofd Programma --------------------- }

begin
  nov  := 0;
  nof  := 0;
  last := 0;
  start('pira', 15,  Opal);

  points[0]     := 0;
  prevpoints[0] := 0;
  hline[0]      := 0;
  prevhline[0]  := 0;

  anim3D;

  finish(Opal);
  Writeln('Coded by ...... " De Vectorman "');
  Writeln;
end.


{ ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±± }

Unit ddfigs;

Interface

Uses
  DDprocs, DDVars;

Const
  cubevert : Array [1..8] of vector3 =
    ((x :  1; y :  1; z :  1),
     (x :  1; y : -1; z :  1),
     (x :  1; y : -1; z : -1),
     (x :  1; y :  1; z : -1),
     (x : -1; y :  1; z :  1),
     (x : -1; y : -1; z :  1),
     (x : -1; y : -1; z : -1),
     (x : -1; y :  1; z : -1));

  cubefacet : Array [1..6, 1..4] of Integer =
    ((1, 2, 3, 4),
     (1, 4, 8, 5),
     (1, 5, 6, 2),
     (3, 7, 8, 4),
     (2, 6, 7, 3),
     (5, 8, 7, 6));

  piravert  : Array [1..5] of vector3 =
    ((x :  0; y :  1; z :  0),
     (x :  1; y :  0; z : -1),
     (x : -1; y :  0; z : -1),
     (x : -1; y :  0; z :  1),
     (x :  1; y :  0; z :  1));

  pirafacet : Array [1..5, 1..3] of Integer =
    ((1, 2, 3),
     (1, 3, 4),
     (1, 4, 5),
     (1, 5, 2),
     (5, 4, 3));

  huisvert  : Array[1..59] of vector3 =
    ((x : -6; y :  0; z :  4), (x :  6; y : 0; z :  4),
     (x :  6; y :  0; z : -4),
     (x : -6; y :  0; z : -4), (x : -6; y : 8; z :  4), (x :  6; y : 8; z :  4),
     (x :  6; y : 11; z :  0), (x :  6; y : 8; z : -4), (x : -6; y : 8; z : -4),
     (x : -6; y : 11; z :  0), (x : -4; y : 1; z :  4), (x : -1; y : 1; z :  4),
     (x : -1; y :  3; z :  4), (x : -4; y : 3; z :  4), (x : -4; y : 5; z :  4),
     (x : -1; y :  5; z :  4), (x : -1; y : 7; z :  4), (x : -4; y : 7; z :  4),
     (x :  0; y :  0; z :  4), (x :  5; y : 0; z :  4), (x :  5; y : 4; z :  4),
     (x :  0; y :  4; z :  4), (x :  1; y : 5; z :  4), (x :  4; y : 5; z :  4),
     (x :  4; y :  7; z :  4), (x :  1; y : 7; z :  4), (x :  6; y : 5; z : -1),
     (x :  6; y :  5; z : -3), (x :  6; y : 7; z : -3), (x :  6; y : 7; z : -1),
     (x :  5; y :  1; z : -4), (x :  2; y : 1; z : -4), (x :  2; y : 3; z : -4),
     (x :  5; y :  3; z : -4), (x :  5; y : 5; z : -4), (x :  2; y : 5; z : -4),
     (x :  2; y :  7; z : -4), (x :  5; y : 7; z : -4), (x :  1; y : 0; z : -4),
     (x : -1; y :  0; z : -4), (x : -1; y : 3; z : -4), (x :  0; y : 4; z : -4),
     (x :  1; y :  3; z : -4), (x : -2; y : 1; z : -4), (x : -5; y : 1; z : -4),
     (x : -5; y :  3; z : -4), (x : -2; y : 3; z : -4), (x : -2; y : 5; z : -4),
     (x : -5; y :  5; z : -4), (x : -5; y : 7; z : -4), (x : -2; y : 7; z : -4),
     (x : -6; y :  0; z :  1), (x : -6; y : 0; z :  3), (x : -6; y : 3; z :  3),
     (x : -6; y :  3; z :  1), (x : -6; y : 5; z :  1), (x : -6; y : 5; z :  3),
     (x : -6; y :  7; z :  3), (x : -6; y : 7; z :  1));

  huissize  : Array [1..19] of Integer =
    (4, 4, 5, 4, 4, 5, 4, 4, 4, 4, 4, 4, 4, 4, 5, 4, 4, 4, 4);

  huissuper : Array [1..19] of Integer =
    (0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 3, 4, 4, 4, 4, 4, 6, 6);

  huisfacet : Array [1..79] of Integer =
    ( 1,  2,  6,  5,
      5,  6,  7, 10,
      2,  3,  8,  7,
      6,  3,  4,  9,
      8,  8,  9, 10,
      7,  4,  1,  5,
     10,  9,  4,  3,
      2,  1, 11, 12,
     13, 14, 15, 16,
     17, 18, 19, 20,
     21, 22, 23, 24,
     25, 26, 27, 28,
     29, 30, 31, 32,
     33, 34, 35, 36,
     37, 38, 39, 40,
     41, 42, 43, 44,
     45, 46, 47, 48,
     49, 50, 51, 52,
     53, 54, 55, 56,
     57, 58, 59);

  stervert : Array [1..6] of vector3 =
    ((x :  1; y :  0; z :  0),
     (x :  0; y :  1; z :  0),
     (x :  0; y :  0; z :  1),
     (x :  0; y :  0; z : -1),
     (x :  0; y : -1; z :  0),
     (x : -1; y :  0; z :  0));

Procedure cubesetup(c : Integer);
Procedure cube(P : matrix4x4);
Procedure pirasetup(c : Integer);
Procedure piramid(P : matrix4x4);
Procedure huissetup;
Procedure huis(P : matrix4x4);
Procedure hollow(P1 : matrix4x4);
Procedure stersetup(col : Integer);
Procedure ster(P : matrix4x4; d : Real);
Procedure ellips(P : matrix4x4; col : Integer);
Procedure goblet(P : matrix4x4; col : Integer);

Implementation

Procedure cubesetup(c : Integer);
{ zet kubusdata in facetlist van de scene}
Var
  i, j : Integer;
begin
  For i :=  1 to 6 DO
  begin
    For j := 1 to 4 DO
      faclist[last + j] := cubefacet[i, j] + nov;
    nof := nof + 1;
    facfront[nof] := last;
    colour[nof]   := c;
    nfac[nof]     := nof;
    super[nof]    := 0;
    firstsup[nof] := 0;
    size[nof]     := 4;
    last := last + size[nof];
  end;
end;

Procedure cube(P : matrix4x4);
Var
  i, j : Integer;
begin
  For i :=  1 to 8 DO
  begin
    nov := nov + 1;
    transform(cubevert[i], P, act[nov]);
  end;
end;

Procedure pirasetup(c : Integer);
Var
  i, j : Integer;
begin
  For i :=  1 to 5 DO
  begin
    For j := 1 to 3 DO
      faclist[last + j] := pirafacet[i, j] + nov;
    nof := nof + 1;
    facfront[nof] := last;
    size[nof]     := 3;
    last          := last + size[nof];
    colour[nof]   := c;
    nfac[nof]     := nof;
    super[nof]    := 0;
    firstsup[nof] := 0;
  end;

  size[nof] := 4;
  faclist[facfront[nof] + 4] := 2 + nov;
  last := last + 1;
end;

Procedure piramid(P : matrix4x4);
Var
  i, j : Integer;
begin
  For i :=  1 to 5 DO
  begin
    nov := nov + 1;
    transform(piravert[i], P, act[nov]);
  end;
end;


Procedure huissetup;
Var
  i, j,
  host,
  nofstore : Integer;
begin
  For i := 1 to 79 DO
    faclist[last + i] := huisfacet[i] + nov;

  nofstore := nof;

  For i := 1 to 19 DO
  begin
    nof           := nof + 1;
    facfront[nof] := last;
    size[nof]     := huissize[i];
    last          := last + size[nof];
    nfac[nof]     := nof;

    if (i = 2) or (i = 5) then
      colour[nof] := 111
    else
    if i = 7 then
      colour[nof] := 20
    else
    if i < 8 then
      colour[nof] := 42
    else
      colour[nof] := 25;

    super[nof] := huissuper[i];
    firstsup[nof] := 0;

    if super[nof] <> 0 then
    begin
      host := super[nof] + nofstore;
      super[nof] := host;
      pushfacet(firstsup[host], nof);
    end;
  end;
  For i  :=  1 to 59 DO
    setup[i] := huisvert[i];
end;

Procedure huis(P : matrix4x4);
Var
  i : Integer;
begin
  For i := 1 to 59 DO
  begin
    nov := nov + 1;
    transform(setup[i], P, act[nov]);
  end;
end;


Procedure hollow(P1 : matrix4x4);
Var
  A, B,
  P, P2 : matrix4x4;
  i     : Integer;
begin
  For i := 1 to 8 DO
  begin
    tran3(4.0 * cubevert[i].x, 4.0 * cubevert[i].y, 4.0 * cubevert[i].z, P2);
    mult3(P1, P2, P);
    cube(P);
  end;

  For i := 1 to 4 DO
  begin
    scale3(3.0, 1.0, 1.0, A);
    tran3(0.0, 4.0 * cubevert[i].y, 4.0 * cubevert[i].z, B);
    mult3(A, B, P2);mult3(P1, P2, P);
    cube(P);
    scale3(1.0, 3.0, 1.0, A);
    tran3(4.0 * cubevert[i].y, 0.0, 4.0 * cubevert[i].z, B);
    mult3(A, B, P2);mult3(P1, P2, P);
    cube(P);
    scale3(1.0, 1.0, 3.0, A);
    tran3(4.0 * cubevert[i].z, 4.0 * cubevert[i].y, 0.0, B);
    mult3(A, B, P2);mult3(P1, P2, P);
    cube(P);
  end;
end;

Procedure stersetup(col : Integer);
Var
  i, j,
  v1, v2 : Integer;
begin
  For i := 1 to 6 DO
  begin
    v1 := cubefacet[i, 4] + nov;
    For j := 1 to 4 DO
    begin
      v2  := cubefacet[i, j] + nov;
      nof := nof + 1;
      faclist[last + 1] := v1;
      faclist[last + 2] := v2;
      faclist[last + 3] := nov + 8 + i;
      facfront[nof]     := last;
      size[nof] := 3;

      last := last + size[nof];
      colour[nof] := col;
      nfac[nof]   := nof;
      super[nof]  := 0;
      firstsup[nof] := 0;
      v1 := v2;
    end;
  end;
end;

Procedure ster(P : matrix4x4; d : Real);
Var
  i, j,
  v1, v2 : Integer;
  A, S   : matrix4x4;
begin
  For i :=  1 to 8 DO
  begin
    nov := nov + 1;
    transform(cubevert[i], P, act[nov]);
  end;

  scale3(D, D, D, A);
  mult3(A, P, S);

  For i := 1 to 6 DO
  begin
    nov := nov + 1;
    transform(stervert[i], S, act[nov]);
  end;
end;

Procedure ellips(P : matrix4x4; col : Integer);
Var
  v : vector2Array;
  theta,
  thetadiff,
  i : Integer;
begin
  theta := -90;
  thetadiff := -9;
  For i :=  1 to 21 DO
  begin
    v[i].x := cosin(theta);
    v[i].y := sinus(theta);
    theta  := theta + thetadiff;
  end;
  bodyofrev(P, col, 21, 20, v);
end;

Procedure goblet(P : matrix4x4; col : Integer);
Const
  gobletdat : Array [1..12] of vector2 =
    ((x :  0; y : -16),
     (x :  8; y : -16),
     (x :  8; y : -15),
     (x :  1; y : -15),
     (x :  1; y :  -2),
     (x :  6; y :  -1),
     (x :  8; y :   2),
     (x : 14; y :  14),
     (x : 13; y :  14),
     (x :  7; y :   2),
     (x :  5; y :   0),
     (x :  0; y :   0));

Var
  gobl : vector2Array;
  i    : Integer;
begin
  For i := 1 to 12 DO
    gobl[i] := gobletdat[i];
  bodyofrev(P, col, 12, 20, gobl)
end;

begin;
end.


{ ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±± }

Unit ddprocs;

Interface

Uses
  DDVars;

Const
  maxv = 200;
  maxf = 400;
  maxlist = 1000;
  vectorArraysize  = 32;
  sizeofpixelArray = 3200;
  sizeofhlineArray = 320 * 4;

Type
  vector2      = Record x, y : Real; end;
  vector3      = Record x, y, z : Real; end;
  pixelvector  = Record x, y : Integer; end;
  pixelArray   = Array [0..sizeofpixelArray] of Integer;
  hlineArray   = Array [0..sizeofhlineArray] of Integer;
  vector3Array = Array [1..vectorArraysize] of vector3;
  matrix3x3    = Array [1..3, 1..3] of Real;
  matrix4x4    = Array [1..4, 1..4] of Real;
  vertex3Array = Array [1..maxv] of vector3;
  vertex2Array = Array [1..maxv] of vector2;
  vector2Array = Array [1..vectorArraysize ] of vector2;
  facetArray   = Array [1..maxf] of Integer;
  facetlist    = Array [1..maxlist] of Integer;

Const
  EenheidsM : matrix4x4 =
    ((1, 0, 0, 0),
     (0, 1, 0, 0),
     (0, 0, 1, 0),
     (0, 0, 0, 1));
Var
  Q           : matrix4x4;
  eye, direct : vector3;
  nov, ntv,
  ntf, nof,
  last        : Integer;
  setup,
  act, obs    : vertex3Array;
  pro         : vertex2Array;
  faclist     : facetlist;
  colour,
  size,
  facfront,
  nfac,
  super,
  firstsup    : facetArray;
  points,
  prevpoints  : pixelArray;
  hline,
  prevhline   : hlineArray;

Procedure tran3(tx, ty, tz : Real; Var A : matrix4x4);
Procedure scale3(sx, sy, sz : Real; Var A : matrix4x4);
Procedure rot3(m : Integer; theta : Integer; Var A : matrix4x4);
Procedure mult3(A, B : matrix4x4; Var C : matrix4x4);
Procedure findQ;
Procedure genrot(phi : Integer; b, d : vector3; Var A : matrix4x4);
Procedure transform(v : vector3; A : matrix4x4; Var w : vector3);
Procedure extrude(P : matrix4x4; d : Real; col, n : Integer;
                  v : vector2Array);
Procedure bodyofrev(P : matrix4x4; col, nvert, nhoriz : Integer;
                    v : vector2Array);
Procedure polydraw(c, n : Integer; poly : vector2Array);
Procedure linepto(c : Integer; pt1, pt2 : vector2);
Procedure WisScherm(punten : pixelArray; SchermSeg, VirSeg : Word);
Procedure fillpoly(c, n : Integer; poly : vector2Array);
Procedure Wis_Hline(hline_ar : hlineArray; virseg : Word);

Implementation

Procedure tran3(tx, ty, tz : Real; Var A : matrix4x4);
{ zet matrix A op punt tx, ty, tz }
begin
  A := EenheidsM;
  A[1, 4] := -tx;
  A[2, 4] := -ty;
  A[3, 4] := -tz;
end;

Procedure scale3(sx, sy, sz : Real; Var A : matrix4x4);
{ zet matrix A om in schaal van sx, sy, sz }
begin
  A := EenheidsM;
  A[1, 1] := sx;
  A[2, 2] := sy;
  A[3, 3] := sz;
end;

Procedure rot3(m : Integer; theta : Integer; Var A : matrix4x4);
{ roteer matrix A om m: 1=x-as; 2=y-as; 3=z-as met hoek theta (in graden)}
Var
  m1, m2 : Integer;
  c, s   : Real;
begin
  A  := EenheidsM;
  m1 := (m MOD 3) + 1;
  m2 := (m1 MOD 3) + 1;
  c  := cosin(theta);
  s  := sinus(theta);
  A[m1, m1] := c;
  A[m2, m2] := c;
  A[m1, m2] := s;
  A[m2, m1] := -s;
end;

Procedure mult3(A, B : matrix4x4; Var C : matrix4x4);
{ vermenigvuldigd matrix A en B naar matrix C }
Var
  i, j, k : Integer;
  ab      : Real