{
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;
begin
  For i := 1 to 4 do
    For j :=  1 to 4 do
    begin
      ab := 0;
      For k := 1 to 4 do
        ab := ab + A[i, k] * B[k, j];
      C[i, j] := ab;
    end;
end;

Procedure findQ;
{ Bereken de Observatie-matrix 'Q' voor een punt in de ruimte }
Var
  E, F, G,
  H, U    : matrix4x4;
  alpha,
  beta,
  gamma   : Integer;
  v, w    : Real;
begin
  tran3(eye.x, eye.y, eye.z, F);

  alpha := angle(-direct.x, -direct.y);
  rot3(3, alpha, G);

  v :=  sqrt( (direct.x * direct.x) + (direct.y * direct.y));
  beta := angle(-direct.z, v);
  rot3(2, beta, H);

  w :=  sqrt( (v * v) + (direct.z * direct.z));
  gamma := angle( -direct.x * w,  direct.y * direct.z);
  rot3(3, gamma, U);

  mult3(G, F, Q);
  mult3(H, Q, E);
  mult3(U, E, Q);
end;

Procedure genrot (phi : Integer; b, d : vector3; Var A : matrix4x4);
Var
  F, G, H,
  W, FI, GI,
  HI, S, T  : matrix4x4;
  v         : Real;
  beta,
  theta     : Integer;
begin
  tran3(b.x, b.y, b.z, F);
  tran3(-b.x, -b.y, -b.z, FI);
  theta := angle(d.x, d.y);
  rot3(3, theta, G);
  rot3(3, -theta, GI);
  v := sqrt(d.x * d.x + d.y * d.y);
  beta := angle(d.z, v);
  rot3(2, beta, H);
  rot3(2, -beta, HI);
  rot3(2, beta, H);
  rot3(2, -beta, HI);
  rot3(3, phi, W);
  mult3(G, F, S);
  mult3(H, S, T);
  mult3(W, S, T);
  mult3(HI, S, T);
  mult3(GI, T, S);
  mult3(FI, S, A);
end;

Procedure transform(v : vector3; A : matrix4x4; Var w : vector3);
{ transformeer colomvector 'v' uit A in colomvector 'w'}
begin
  w.x := A[1, 1] * v.x + A[1, 2] * v.y + A[1, 3] * v.z + A[1, 4];
  w.y := A[2, 1] * v.x + A[2, 2] * v.y + A[2, 3] * v.z + A[2, 4];
  w.z := A[3, 1] * v.x + A[3, 2] * v.y + A[3, 3] * v.z + A[3, 4];
end;

Procedure extrude(P : matrix4x4; d : Real; col, n : Integer;
                  v : vector2Array);
{ Maakt van een 2d-figuur een 3d-figuur }
{ vb: converteert 2d-letters naar 3d-letters }
Var
  i, j,
  lasti : Integer;
  v3    : vector3;
begin
  For i := 1 to n DO
  begin
    faclist[last + i] := nov + i;
    faclist[last + n + i] := nov + 2 * n + 1 - i;
  end;
  facfront[nof + 1] := last;
  facfront[nof + 2] := last + n;
  size[nof + 1] := n;
  size[nof + 2] := n;
  nfac[nof + 1] := nof + 1;
  nfac[nof + 2] := nof + 2;
  super[nof + 1] := 0;
  super[nof + 2] := 0;
  firstsup[nof + 1] := 0;
  firstsup[nof + 2] := 0;
  colour[nof + 1] := col;
  colour[nof + 2] := col;
  last  := last + 2 * n;
  nof   := nof + 2;
  lasti := n;

  For i := 1 to n DO
  begin
    faclist[last + 1] := nov + i;
    faclist[last + 2] := nov + lasti;
    faclist[last + 3] := nov + n + lasti;
    faclist[last + 4] := nov + n + i;
    nof := nof + 1 ;
    facfront[nof] := last;
    size[nof]     := 4;
    nfac[nof]     := nof;
    super[nof]    := 0;
    firstsup[nof] := 0;
    colour[nof]   := col;
    last  := last + 4;
    lasti := i;
  end;
  For i :=  1 To n DO
  begin
    v3.x := v[i].x;
    v3.y := v[i].y;
    v3.z := 0.0;
    nov  := nov + 1;
    transform(v3, P, act[nov]);
    v3.z := -d;
    transform(v3, P, act[nov + n]);
  end;
  nov := nov + n;
end;

Procedure bodyofrev(P : matrix4x4; col, nvert, nhoriz : Integer;
                    v : vector2Array);
{ maakt een "rond" figuur van een 2-dimensionale omlijning van het figuur }
Var
  theta,
  thetadiff,
  i, j, newnov : Integer;
  c, s         : Array [1 .. 100] of Real;
  index1,
  index2       : Array [1 .. 101] of Integer;
begin
  theta := 0;
  thetadiff := trunc(360 / nhoriz);

  For i := 1 to nhoriz DO
  begin
    c[i]  := cosin(theta);
    s[i]  := sinus(theta);
    theta := theta + thetadiff;
  end;
  newnov := nov;

  if abs(v[1].x) < epsilon  then
  begin
    newnov := newnov + 1;
    setup[newnov].x := 0.0;
    setup[newnov].y := v[1].y;
    setup[newnov].z := 0.0;
    For i := 1 to nhoriz + 1 DO
      index1[i] := newnov;
  end
  else
  begin
    For i := 1 to nhoriz DO
    begin
      newnov := newnov + 1;
      setup[newnov].x := v[1].x * c[i];
      setup[newnov].y := v[1].y;
      setup[newnov].z := -v[1].x * s[i];
      index1[i] := newnov;
    end;
    index1[nhoriz + 1] := index1[i];
  end;

  For j :=  2 to nvert DO
  begin
    if abs(v[j].x) < epsilon then
    begin
      newnov := newnov + 1;
      setup[newnov].x := 0.0;
      setup[newnov].y := v[j].y;
      setup[newnov].z := 0.0;
      For i := 1 to nhoriz + 1 DO
        index2[i] := newnov;
    end
    else
    begin
      For i := 1 To nhoriz DO
      begin
        newnov := newnov + 1;
        setup[newnov].x :=  v[j].x * c[i];
        setup[newnov].y :=  v[j].y;
        setup[newnov].z := -v[j].x * s[i];
        index2[i] := newnov;
      end;
      index2[nhoriz + 1] := index2[1];
    end;

    if index1[1] <> index1[2] then
      if index2[1] = index2[2] then
      begin
        For i := 1 to nhoriz DO
        begin
          nof := nof + 1; size[nof] := 3;
          facfront[nof] := last;
          faclist[last + 1] := index1[i + 1];
          faclist[last + 2] := index2[i];
          faclist[last + 3] := index1[i];
          last := last + size[nof];
          nfac[nof]     := nof;
          colour[nof]   := col;
          super[nof]    := 0;
          firstsup[nof] := 0;
        end;
      end
      else
      begin
        For i := 1 to nhoriz DO
        begin
          nof := nof + 1;
          size[nof] := 4;
          facfront[nof] := last;
          faclist[last + 1] := index1[i + 1];
          faclist[last + 2] := index2[i + 2];
          faclist[last + 3] := index2[i];
          faclist[last + 4] := index1[i];
          last := last + size[nof];
          nfac[nof]     := nof;
          colour[nof]   := col;
          super[nof]    := 0;
          firstsup[nof] := 0;
        end;
      end
      else
      if index2[1] <> index2[2] then
        For i := 1 to nhoriz DO
        begin
          nof := nof + 1;
          size[nof] := 3;
          facfront[nof] := last;
          faclist[last + 1] := index2[i + 1];
          faclist[last + 2] := index2[i];
          faclist[last + 3] := index1[i];
          last := last + size[nof];
          nfac[nof]     := nof;
          colour[nof]   := col;
          super[nof]    := 0;
          firstsup[nof] := 0;
        end;

        For i :=  1 to nhoriz + 1 DO
          index1[i] := index2[i];
  end;

  For i :=  nov + 1 to newnov DO
    transform(setup[i], P, act[i]);

  nov := newnov;

end;

Procedure BressenHam( Virseg : Word;          { Adres-> VIRSEG:0 }
                      pnts   : pixelArray;
                      c      : Byte;          { c->     kleur    }
                      p1, p2 : pixelvector);  { vector           } Assembler;
Var
  x, y, error,
  s1,  s2,
  deltax,
  deltay, i   : Integer;
  interchange : Boolean;
  dcolor      : Word;
Asm
{  initialize Variables  }
  PUSH   ds
  LDS    si, pnts
  MOV    ax, virseg
  MOV    es, ax
  MOV    cx, 320
  MOV    ax, p1.x
  MOV    x,  ax
  MOV    ax, p1.y
  MOV    y, ax
  MOV    dcolor, ax

  MOV    ax, p2.x                { deltax := abs(x2 - x1) }
  SUB    ax, p1.x                { s1 := sign(x2 - x1) }
  PUSH   ax
  PUSH   ax
  CALL   ddVars.sign
  MOV    s1, ax;
  POP    ax
  TEST   ax, $8000
  JZ     @@GeenSIGN1
  NEG    ax
 @@GeenSign1:
  MOV    deltax, ax
  MOV    ax, p2.y
  SUB    ax, p1.y
  PUSH   ax
  PUSH   ax
  CALL   ddVars.sign
  MOV    s2, ax
  POP    ax
  TEST   ax, $8000
  JZ     @@GeenSign2
  NEG    ax
 @@GeenSign2:
  MOV    deltay, ax

 { Interchange DeltaX and DeltaY depending on the slope of the line }

  MOV    interchange, False
  CMP    ax, deltax
  JNG    @@NO_INTERCHANGE
  XCHG   ax, deltax
  XCHG   ax, deltay
  MOV    interchange, True

 @@NO_INTERCHANGE:

  { Initialize the error term to compensate For a nonzero intercept }

  MOV    ax, deltaY
  SHL    ax, 1
  SUB    ax, deltaX
  MOV    error, ax

  { Main loop }
  MOV    ax, 1
  MOV    i, ax
 @@FOR_begin:
  CMP    ax, deltaX
  JG     @@EINDE_FOR_LOOP

  { Plot punt! }
  MOV   bx, x
  MOV   ax, y
  MUL   cx
  ADD   bx, ax
  MOV   al, c
  MOV   Byte PTR [es:bx], al
  INC   [Word ptr ds:si]     { aantal verhogen }
  MOV   ax, [si]
  SHL   ax, 1                { offset berekenen }
  PUSH  si
  ADD   si, ax
  MOV   [si], bx
  POP   si

  { While Loop }
 @@W1_begin:
  CMP    error, 0
  JL     @@EINDE_WHILE

  { if interchange then }

  CMP    interchange, True
  JE     @@i_is_t
  MOV    ax, s2
  ADD    y, ax
  JMP    @@w1_eruit

 @@i_is_t:
  MOV    ax, s1
  ADD    x, ax

 @@w1_eruit:
  MOV    ax, deltax
  SHL    ax, 1
  SUB    error, ax
  JMP    @@w1_begin

 @@EINDE_WHILE:
  CMP    interchange, True
  JE     @@i_is_t_1
  MOV    ax, s1
  ADD    x, ax
  JMP    @@if_2_eruit

 @@i_is_t_1:
  MOV    ax, s2
  ADD    y, ax

 @@if_2_eruit:
  MOV    ax, deltay
  SHL    ax, 1
  ADD    error, ax
  INC    i
  MOV    ax, i
  JMP    @@FOR_begin
 @@Einde_for_loop:
  POP    ds
end;

Procedure linepto(c : Integer; pt1, pt2 : vector2);
Var
  p1, p2 : pixelvector;
begin
  p1.x := fx(pt1.x);
  p1.y := fy(pt1.y);
  p2.x := fx(pt2.x);
  p2.y := fy(pt2.y);
  BressenHam($a000, points, c,  p1,  p2);
end;

Procedure WisScherm(punten : pixelArray; SchermSeg , Virseg : Word); Assembler;
Asm
  PUSH      ds
  MOV       ax, SchermSeg
  MOV       es, ax
  LDS       bx, punten
  MOV       cx, [bx]
  JCXZ      @@NietTekenen
 @@Wis:
  INC       bx
  INC       bx
  MOV       si, [bx]
  MOV       di, si
  PUSH      ds
  MOV       ax, virseg
  MOV       ds, ax
  MOVSB
  POP       ds
  LOOP      @@Wis
 @@NietTekenen:
  POP       ds
end;

Procedure polydraw(c, n : Integer; poly : vector2Array);
Var
  i : Integer;
begin
  For i :=  1 to n - 1 do
    linepto(c, poly[i], poly[i + 1]);
  linepto(c, poly[n], poly[1]);
end;

Procedure fillpoly(c, n : Integer; poly : vector2Array);
Var
  scan_table : tabel;
  scanline,
  line,
  offsetx    : Integer;

  Procedure Draw_horiz_line(hline_ar  : hlineArray;
                            color     : Byte;
                            lijn      : Word;
                            begin_p   : Word;
                            linelen   : Word); Assembler;
  Asm
    PUSH  ds
    MOV   cx, 320
    MOV   ax, 0a000h
    MOV   es, ax
    MOV   di, begin_p
    MOV   ax, lijn
    MUL   cx
    ADD   di, ax
    PUSH  di
    MOV   al, color
    MOV   cx, linelen
    PUSH  cx
    REP   STOSB
    LDS   si, hline_ar
    INC   [Word ptr ds:si]
    MOV   ax, [si]
    SHL   ax, 1
    SHL   ax, 1
    ADD   si, ax
    POP   bx
    POP   dx
    MOV   [si], dx
    MOV   [si + 2], bx
    POP   ds
  end;

  Procedure swap(Var x, y : Integer);
  begin
    x := x + y;
    y := x - y;
    x := x - y;
  end;

{
Procedure Calc_x(x1, y1, x2, y2 : Word; Var scan_table : tabel);
Var
  m_inv,
  xReal : Real;
begin
  Asm
    LDS     dx, scan_table
    MOV     ax, y1
    MOV     bx, y2
    CMP     ax, bx
    JNE     @@NotHorizLine
    MOV     bx, x1
    SHL     ax, 1
    ADD     ax, dx
    CMP     bx, [dx]
    JGE     @@Notstorexmin
    MOV     [dx], bx

   @@Notstorexmin:
    INC     dx
    MOV     bx, x2
    CMP     bx, [dx]
    JLE     @@Klaar
    MOV     [dx], bx
    JMP     @@Klaar

   @@NotHorizLine:
}

  Procedure Calc_x(x1, y1, x2, y2 : Integer; Var scan_table : tabel);
  Var
    m_inv, xReal : Real;
    i, y, temp   : Integer;
  begin
    if y1 = y2 then
    begin
      if x2 < x1 then
        swap(x1, x2)
      else
      begin
        if x1 < scan_table[y1].xmin then
          scan_table[y1].xmin := x1;
        if x2 > scan_table[y2].xmax then
          scan_table[y2].xmax := x2;
      end;
    end
    else
    begin
      m_inv := (x2 - x1) / (y2 - y1);

      if y1 > y2 then {swap}
      begin
        swap(y1, y2);
        swap(x1, x2);
      end;

      if x1 < scan_table[y1].xmin then
        scan_table[y1].xmin := x1;
      if x2 > scan_table[y2].xmax then
        scan_table[y2].xmax := x2;
      xReal := x1; y := y1;

      While y < y2 do
      begin
        y := y + 1;
        xReal := xReal + m_inv;
        offsetx := round(xReal);
        if xReal < scan_table[y].xmin then
          scan_table[y].xmin := offsetx;
        if xReal > scan_table[y].xmax then
          scan_table[y].xmax := offsetx;
      end;
    end;
  end;

begin
  scan_table := emptytabel;
  For line := 1 to n - 1 do
    calc_x(fx(poly[line].x), fy(poly[line].y),
           fx(poly[line + 1].x), fy(poly[line + 1].y), scan_table);

  calc_x(fx(poly[n].x), fy(poly[n].y),
         fx(poly[1].x), fy(poly[1].y), scan_table);

  scanline := 0;

  While scanline < nypix - 1 do
  begin
    With Scan_table[scanline] DO
      if xmax > xmin then
        draw_horiz_line(hline, c,  scanline,  xmin,  xmax - xmin + 1);
      scanline := scanline + 1;
  end;
end;

Procedure  Wis_Hline(hline_ar : hlineArray; virseg : Word); Assembler;
Asm
  PUSH      ds
  MOV       ax, 0a000h
  MOV       es, ax
  LDS       bx, hline_ar
  MOV       cx, [bx]
  JCXZ      @@Niet_tekenen
  ADD       bx, 4
 @@Wis:
  XCHG      cx, dx
  MOV       si, [bx]
  MOV       cx, [bx + 2]
  MOV       di, si
  PUSH      ds
  MOV       ax, virseg
  MOV       ds, ax
  CLD
  REP       MOVSB
  POP       ds
  XCHG      cx, dx
  ADD       bx, 4
  LOOP      @@Wis
 @@Niet_tekenen:
  POP       ds
end;

begin
end.


{ ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ }

Unit
  ddVars;

Interface

Const
  pi      = 3.1415926535;
  epsilon = 0.000001;
  rad     = pi / 180;
  nxpix   = 320; { scherm resolutie }
  nypix   = 200;
  maxfinf = 200;

Type
  xmaxymax  = Record xmin, xmax : Integer; end;
  facetinfo = Record info, Pointer : Integer; end;
  tabel     = Array [1..nypix - 1] of xmaxymax;
  sincos    = Array [0..359] of Real;

Var
  sinusArray   : sincos;
  cosinusArray : sincos;
  facetinfacet : Array [1..maxfinf] of facetinfo;
  facetfree    : Integer;
  xyscale      : Real;
  emptytabel   : tabel;

Function  fx(x : Real) : Integer;
Function  fy(y : Real) : Integer;
Function  Sign(I : Integer) : Integer;
Function  macht(a, n : Real) : Real;
Function  angle(x, y : Real) : Integer;
Function  sinus(hoek : Integer) : Real;
Function  cosin(hoek : Integer) : Real;
Procedure pushfacet(Var stackname : Integer; value : Integer);

Implementation

Function fx(x : Real) : Integer;
begin
  fx := nxpix - trunc(x * xyscale + nxpix * 0.5 - 0.5);
end;

Function fy(y : Real) : Integer;
begin
  fy := nypix - trunc(y * xyscale + nypix * 0.5 - 0.5);
end;

Function Sign(I : Integer) : Integer; Assembler;
Asm
  MOV  ax, i
  CMP  ax, 0
  JGE  @@Zero_or_one
  MOV  ax, -1
  JMP  @@Exit

 @@Zero_or_One:
  JE   @@Nul
  MOV  ax, 1
  JMP  @@Exit

 @@Nul:
  xor  ax, ax

 @@Exit:
end;

Function macht(a, n : Real) : Real;
begin
  if a > 0 then
    macht :=  exp(n * (ln(a)))
  else
  if a < 0 then
    macht := -exp(n * (ln(-a)))
  else
    macht := a;
end;

Function angle(x, y : Real) : Integer;
begin
  if abs(x) < epsilon then
    if abs(y) < epsilon then
      angle := 0
    else
    if y > 0.0 then
      angle := 90
    else
      angle := 270
  else
  if x < 0.0 then
    angle := round(arctan(y / x) / rad) + 180
  else
    angle := round(arctan(y / x) / rad);
end;

Function sinus(hoek : Integer) : Real;
begin
  hoek  := hoek mod 360;
  sinus := sinusArray[hoek];
end;

Function cosin(hoek : Integer) : Real;
begin
  hoek  := hoek mod 360 ;
  cosin := cosinusArray[hoek];
end;

Procedure pushfacet(Var stackname : Integer; value : Integer);
Var
  location : Integer;
begin
  if facetfree = 0 then
  begin
    Write('Cannot hold more facets');
    HALT;
  end
  else
  begin
    location  := facetfree;
    facetfree := facetinfacet[facetfree].Pointer;
    facetinfacet[location].info := value;
    facetinfacet[location].Pointer := stackname;
    stackname := location;
  end;
end;

Var
  i : Integer;
begin
  { vul sinus- en cosinusArray met waarden }
  For i := 0 to 359 DO
  begin
    sinusArray[i]   := sin(i * rad);
    cosinusArray[i] := cos(i * rad);
  end;
  { Init facetinfacet }
  facetfree := 1;
  For i :=  1 to maxfinf - 1 DO
    facetinfacet[i].Pointer := i + 1;

  facetinfacet[maxfinf].Pointer := 0;

  { Init EmptyTabel }
  For i := 0 to nypix - 1 DO
  begin
    Emptytabel[i].xmin := 319;
    Emptytabel[i].xmax := 0;
  end;
end.


{ ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ }

Unit ddvideo;

Interface

Uses
  Dos, DDVars;

Type
  schermPointer = ^schermType;
  schermType    = Array [0..nypix - 1, 0..nxpix - 1] of Byte;
  color         = Record  R, G, B : Byte; end;
  paletteType   = Array [0..255] of color;
  WordArray     = Array [0..3] of Word;
  palFile       = File of paletteType;
  picFile       = File of schermType;

Var
  scherm    : schermType Absolute $8A00 : $0000;
  schermptr : schermPointer;
  switch    : Integer;

Procedure start(Filenaam : String; horiz : Real; Var Oldpal : paletteType);
Procedure finish(Oldpal : paletteType);
Procedure VirScherm_actief(switch : Word);
Procedure Scherm_actief(switch : Word);

Implementation

Procedure Virscherm_actief(switch : Word); Assembler;
Asm
  MOV     dx, 3cch
  MOV     cx, switch
  JCXZ    @@volgende
  in      al, dx             { switch=1 }
  and     al, 0dfh
  MOV     dx, 3c2h
  OUT     dx, al             { set even mode }
  JMP     @@Klaar

 @@Volgende:
  in      al, dx             { switch=0 }
  or      al, 20h
  MOV     dx, 3c2h
  OUT     dx, al             { set odd mode }

 @@Klaar:
  MOV     dx, 3dah           { Wacht op Vert-retrace }
  in      al, dx             { Zodat virscherm = invisible }
  TEST    al, 08h
  JZ      @@Klaar
end;

Procedure Scherm_actief(switch : Word);
begin
  Asm
   @@Wacht:
    MOV  dx, 3dah
    in   al, dx
    TEST al, 01h
    JNZ  @@Wacht
  end;
  port[$3d4] := $c;
  port[$3d5] := switch * $80;
end;

Procedure SetVgaPalette(Var p : paletteType);
Var
  regs : Registers;
begin
  With regs do
  begin
    ax := $1012;
    bx := 0;
    cx := 256;
    es := seg(p);
    dx := ofs(p);
  end;
  intr ($10, regs);
end;


Procedure start(Filenaam : String; horiz : Real; Var Oldpal : paletteType);

  Procedure readimage(Filenaam : String; Var pal : paletteType);

    Function FileExists(FileName : String) : Boolean;
    Var
      f : File;
    begin
      {$I-}
      Assign(f,  FileName);
      Reset(f);
      Close(f);
      {$I + }
      FileExists := (IOResult = 0) and (FileName <> '');
    end;

  Var
    pFile : picFile;
    lFile : palFile;
    a     : Integer;
  begin
    if (FileExists(Filenaam + '.pal')) and
       (FileExists(Filenaam + '.dwg')) then
    begin
      assign(lFile, Filenaam + '.pal');
      reset(lFile);
      read(lFile, pal);
      close(lFile);
      assign(pFile, Filenaam + '.dwg');
      reset(pFile);
      read(pFile, schermptr^);
      close(pFile);
    end
    else
    begin
      Writeln('Palette en Picture bestanden niet gevonden....');
      Halt;
    end;
  end;

  Procedure SetVgaMode; Assembler;
  Asm
    mov  ah, 0
    mov  al, 13h
    int  $10
  end;

  Procedure GetVgaPalette(Var p : paletteType);
  Var
    regs : Registers;
  begin
    With regs do
    begin
      ax := $1017;
      bx := 0;
      cx := 256;
      es := seg(p);
      dx := ofs(p);
    end;
    intr ($10, regs);
  end;

Var
  pal : paletteType;

begin
  getmem(schermptr, sizeof(schermType));
  readimage(Filenaam, pal);
  GetVgaPalette(OldPal);
  SetVgaPalette(pal);
  SetVgaMode;
  move(schermptr^, scherm, nypix * nxpix);
  Virscherm_actief(0);
  move(schermptr^, mem[$A000 : 0], nypix * nxpix);     { blanko scherm }
  VirScherm_actief(1);
  move(schermptr^, mem[$A000 : 0], nypix * nxpix);     { blanko scherm }
  Scherm_actief(1);
  switch  := 0;
  xyscale := (nypix - 1) / horiz;
end;

Procedure finish(Oldpal : paletteType);

  Procedure SetNormalMode; Assembler;
  Asm
    mov  ah,  0
    mov  al,  3
    int  $10
  end;

begin
  SetVgaPalette(Oldpal);
  SetNormalMode;
  Virscherm_actief(0);
  Freemem(schermptr, sizeof(schermType));
end;

begin
end.