home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / PXDTUT4.ZIP / PXDTUT4.PAS < prev    next >
Pascal/Delphi Source File  |  1997-06-21  |  39KB  |  1,495 lines
  1. program pxdtut4;
  2.  
  3. uses
  4.  crt;
  5.  
  6. CONST
  7.  VGA = $a000;
  8.  
  9.  Num_of_points = 8;
  10.  Num_of_faces = 6;
  11.  
  12.  Xofs = 160;
  13.  yofs = 100;
  14.  Zeye = -200;
  15.  
  16.  YTopClip = 0;
  17.  YBotClip = 200;
  18.  
  19.  
  20. TYPE
  21.   PointT = record
  22.              x,y,z : integer;
  23.           end;                                {6 bytes pr point}
  24.  
  25.   RealPointT = Record
  26.                 x,y,z : real;                {18 bytes pr. point}
  27.               end;
  28.  
  29.  
  30.   ScrPointT = record
  31.                x,y : integer;                 {4 bytes pr point}
  32.              end;
  33.  
  34.   FaceT = record
  35.            P1,P2,P3,P4 : integer;             {9 bytes pr face}
  36.            color  : byte;
  37.          end;
  38.  
  39.  
  40.   SegmentT = Array[0..65534] of byte;
  41.   Virseg = ^SegmentT;
  42.  
  43.  
  44.   PointRecord    = Array[1..Num_of_points] of PointT;    {points *  6 bytes}
  45.   FaceRecord     = Array[1..Num_of_faces] of FaceT;      {faces  *  9 bytes}
  46.   ScrPointRecord = Array[1..Num_of_points] of ScrPointT; {points *  4 bytes}
  47.   CenterRecord   = Array[1..Num_of_faces] of integer;    {faces  *  2 bytes}
  48.   NormalRecordT  = Array[1..Num_of_faces] of PointT;     {faces  *  6 bytes}
  49.  
  50.  
  51.   Virtualscreen = Array[1..64000] of byte;
  52.   Virscr = ^VirtualScreen;
  53.  
  54. VAR
  55.  lookup     : Array [0..360,1..2] of integer; {Our sin and cos lookup table}
  56.  Baseobj    : PointRecord;       {original 3d-object}
  57.  Faces      : FaceRecord;        {data for how faces is defined}
  58.  Points     : PointRecord;       {rotated 3d-object}
  59.  Translated : ScrPointRecord;    {the 2d-screenpoints for drawing}
  60.  Centers    : CenterRecord;      {Z-val of centers for depth sorting}
  61.  OrderTable : Array[1..Num_of_faces] of integer; {how to handle faces correct}
  62.  Normals    : NormalRecordT;     {original normalized normal vectors}
  63.  RotNormals : NormalRecordT;     {Rotated normal vectors}
  64.  LightVect  : RealPointT;        {where is the lightsource ?? }
  65.  
  66.  
  67.  Xrot,Yrot, Zrot : integer;
  68.  scr2 : virscr;
  69.  vaddr : word;
  70.  
  71.  TexSegment : Virseg;
  72.  texture : word;
  73.  
  74.  
  75.  
  76. PROCEDURE WaitRetrace;
  77. Assembler;
  78. label l1,l2;
  79.  
  80. asm
  81.  mov dx,3DAh
  82. l1:
  83.   in al,dx
  84.   and al,08h
  85.   jnz l1
  86. l2:
  87.   in al,dx
  88.   and al,08h
  89.   jz l2
  90. END;
  91.  
  92.  
  93. Procedure FlipScreen(source, dest : word);
  94. Assembler; {386 only}
  95. asm
  96.   mov     dx, ds
  97.   mov     ax, [dest]
  98.   mov     es, ax
  99.   mov     ax, [source]
  100.   mov     ds, ax
  101.   xor     si, si
  102.   xor     di, di
  103.   mov     cx, 16000
  104.   db      $66
  105.   rep     movsw
  106.   mov     ds,dx    {mov's are faster than push / pops }
  107. end;
  108.  
  109. Procedure Clear (Col : Byte;where:word);
  110. Assembler;
  111.      asm
  112.         mov     cx, 32000;
  113.         mov     ax,where
  114.         mov     es,ax
  115.         xor     di,di
  116.         mov     al,[col]
  117.         mov     ah,al
  118.         rep     stosw
  119.       END;
  120.  
  121. Function rad (theta : real) : real;
  122. BEGIN
  123.   rad := theta * pi / 180
  124. END;
  125.  
  126. Procedure Greyscale;
  127. var
  128.  taeller : integer;
  129. begin
  130.  for taeller := 0 to 63 do
  131.    begin   {63 shades from black to white}
  132.     port[$3C8] := taeller;
  133.     port[$3C9] := taeller;
  134.     port[$3C9] := taeller;
  135.     port[$3C9] := taeller;
  136.    end;
  137. end;
  138.  
  139. Procedure PurplePal;
  140. var
  141.  taeller : integer;
  142. begin
  143.  for taeller := 0 to 63 do
  144.    begin   {63 shades from black to purple}
  145.     port[$3C8] := taeller;
  146.     port[$3C9] := taeller;
  147.     port[$3C9] := 0;
  148.     port[$3C9] := taeller;
  149.    end;
  150. end;
  151.  
  152. Procedure FakePhongPal;
  153. var
  154.  taeller : integer;
  155. begin
  156.  for taeller := 1 to 63 do
  157.    begin   {63 shades from black to purple}
  158.     port[$3C8] := taeller;
  159.     port[$3C9] := taeller;
  160.     port[$3C9] := 10+Round(taeller/1.4);
  161.     port[$3C9] := 20+Round(taeller/1.6);
  162.    end;
  163. end;
  164.  
  165.  
  166. PROCEDURE SetUpVirtual(VAR screenname:virscr;VAR add : word);
  167. BEGIN
  168.   GetMem (Screenname,64000);
  169.   add := seg (Screenname^);
  170.   clear(0,add);
  171. END;
  172.  
  173. PROCEDURE ShutDown(Screenname:virscr);
  174. BEGIN
  175.   FreeMem (Screenname,64000);
  176. END;
  177.  
  178. PROCEDURE SetUpSegment(VAR segname:virseg;VAR add : word);
  179. BEGIN
  180.   GetMem (Segname,65534);
  181.   add := seg (Segname^);
  182. END;
  183.  
  184. PROCEDURE CalcFakePhongMap(where : word);
  185. var
  186.  I,J : byte;
  187. begin
  188. For I:=0 To 255 Do For J:=0 To 255 Do
  189.   Begin
  190.      Mem[where:(256*I)+J]:=
  191.          Round(Sqr(Sqr(Sin(I/81.487)))*Sqr(Sqr(Sin(J/81.487)))*62)+1;
  192.    {
  193.      Mem[$A000:320*Round(I/1.25)+J]:=Mem[where:(256*I)+J];
  194.     }
  195.  
  196.   end;
  197. end;
  198.  
  199. PROCEDURE PointNormal(nr : integer; var result : RealPointT);
  200. var
  201.  taeller : integer;
  202.  AntalHits    : byte;
  203.  SumX,SumY,SumZ     : integer;
  204.  Hits    : Array[1..25] of integer;
  205.  length : real;
  206. begin
  207. AntalHits := 0;
  208. SumX := 0;  SumY := 0; SumZ := 0;
  209.  For taeller := 1 to Num_Of_Faces do
  210.      if (faces[taeller].P1 = nr) or (faces[taeller].P2 = nr) or
  211.         (faces[taeller].P3 = nr) or (faces[taeller].P4 = nr) then
  212.           begin
  213.             inc(AntalHits);
  214.             Hits[AntalHits] := taeller;
  215.           end; {in which faces does the point appear}
  216.  
  217.  For taeller := 1 to AntalHits do
  218.    begin
  219.       SumX := SumX + RotNormals[hits[taeller]].X;
  220.       SumY := SumY + RotNormals[hits[taeller]].Y;
  221.       SumZ := SumZ + RotNormals[hits[taeller]].Z;
  222.    end;
  223. result.X := (SumX div AntalHits) / 256;
  224. result.Y := (SumY div AntalHits) / 256;
  225. result.Z := (SumZ div AntalHits) / 256;
  226.  
  227. length := sqrt(Result.X*Result.X + Result.Y * Result.Y + Result.Z*Result.Z);
  228.  
  229. Result.X := Result.X / length;
  230. Result.Y := Result.Y / length;
  231. Result.Z := Result.Z / length;
  232.  
  233. {result is the average values of the normals to the faces in which the point
  234.  appear}
  235. end;
  236.  
  237. PROCEDURE FixedPointNormal(nr : integer; var result : PointT);
  238. var
  239.  taeller : integer;
  240.  AntalHits    : byte;
  241.  SumX,SumY,SumZ     : integer;
  242.  Hits    : Array[1..25] of integer;
  243.  tempx,tempy,tempz : real;
  244.  length : real;
  245. begin
  246. AntalHits := 0;
  247. SumX := 0;  SumY := 0; SumZ := 0;
  248.  For taeller := 1 to Num_Of_Faces do
  249.      if (faces[taeller].P1 = nr) or (faces[taeller].P2 = nr) or
  250.         (faces[taeller].P3 = nr) or (faces[taeller].P4 = nr) then
  251.           begin
  252.             inc(AntalHits);
  253.             Hits[AntalHits] := taeller;
  254.           end; {in which faces does the point appear}
  255.  
  256.  For taeller := 1 to AntalHits do
  257.    begin
  258.       SumX := SumX + RotNormals[hits[taeller]].X;
  259.       SumY := SumY + RotNormals[hits[taeller]].Y;
  260.       SumZ := SumZ + RotNormals[hits[taeller]].Z;
  261.    end;
  262.  
  263. tempX := (SumX div AntalHits) / 256;
  264. tempY := (SumY div AntalHits) / 256;
  265. tempZ := (SumZ div AntalHits) / 256;
  266.  
  267. length := sqrt(tempX*tempX + TempY * TempY + TempZ*TempZ);
  268.  
  269. Result.X := Round((TempX / length)*256);
  270. Result.Y := Round((TempY / length)*256);
  271. Result.Z := Round((TempZ / length)*256);
  272.  
  273. {result is the average values of the normals to the faces in which the point
  274.  appear}
  275. end;
  276.  
  277. Procedure Calc_Cos_sin;
  278. var
  279.  loop1 : integer;
  280. begin
  281.  For loop1:=0 to 360 do
  282.    BEGIN
  283.     lookup [loop1,1]:=round(sin (rad (loop1))*16384);
  284.     lookup [loop1,2]:=round(cos (rad (loop1))*16384);
  285.    END;
  286. end;
  287.  
  288. FUNCTION Xconv(X,Z : integer):integer;
  289. BEGIN
  290.  Xconv:=Xofs+Round(X*(Zeye/(Zeye-Z)));
  291. END;
  292.  
  293. FUNCTION Yconv(Y,Z : integer):integer;
  294. BEGIN
  295.  Yconv:=Yofs+Round(Y*(Zeye/(Zeye-Z)));
  296. END;
  297.  
  298.  
  299.  
  300.  
  301. Procedure RotatePoint (Xrot,Yrot,Zrot,Xin,Yin,Zin:Integer;var Xout,Yout,Zout : integer);
  302. VAR
  303.   a,b,c:integer;
  304. BEGIN
  305.       b:=lookup[Yrot,2];
  306.       c:=Xin;
  307.       asm
  308.         mov   ax,b
  309.         imul  c
  310.         sal   ax,1
  311.         rcl   dx,1
  312.         sal   ax,1
  313.         rcl   dx,1
  314.         mov   a,dx
  315.       end;
  316.       b:=lookup[Yrot,1];
  317.       c:=Zin;
  318.       asm
  319.         mov   ax,b
  320.         imul  c
  321.         sal   ax,1
  322.         rcl   dx,1
  323.         sal   ax,1
  324.         rcl   dx,1
  325.         add   a,dx
  326.       end;
  327.       Xout:=a;
  328.       Yout:=Yin;
  329.       b:=-lookup[Yrot,1];
  330.       c:=Xin;
  331.       asm
  332.         mov   ax,b
  333.         imul  c
  334.         sal   ax,1
  335.         rcl   dx,1
  336.         sal   ax,1
  337.         rcl   dx,1
  338.         mov   a,dx
  339.       end;
  340.       b:=lookup[Yrot,2];
  341.       c:=Zin;
  342.       asm
  343.         mov   ax,b
  344.         imul  c
  345.         sal   ax,1
  346.         rcl   dx,1
  347.         sal   ax,1
  348.         rcl   dx,1
  349.         add   a,dx
  350.       end;
  351.       Zout:=a;
  352.  
  353.   if (Xrot<>0) THEN
  354.      BEGIN
  355.         b:=lookup[Xrot,2];
  356.         c:=Yout;
  357.         asm
  358.           mov   ax,b
  359.           imul  c
  360.           sal   ax,1
  361.           rcl   dx,1
  362.           sal   ax,1
  363.           rcl   dx,1
  364.           mov   a,dx
  365.         end;
  366.         b:=lookup[Xrot,1];
  367.         c:=Zout;
  368.         asm
  369.           mov   ax,b
  370.           imul  c
  371.           sal   ax,1
  372.           rcl   dx,1
  373.           sal   ax,1
  374.           rcl   dx,1
  375.           sub   a,dx
  376.         end;
  377.         b:=lookup[Xrot,1];
  378.         c:=Yout;
  379.         Yout:=a;
  380.         asm
  381.           mov   ax,b
  382.           imul  c
  383.           sal   ax,1
  384.           rcl   dx,1
  385.           sal   ax,1
  386.           rcl   dx,1
  387.           mov   a,dx
  388.         end;
  389.         b:=lookup[Xrot,2];
  390.         c:=Zout;
  391.         asm
  392.           mov   ax,b
  393.           imul  c
  394.           sal   ax,1
  395.           rcl   dx,1
  396.           sal   ax,1
  397.           rcl   dx,1
  398.           add   a,dx
  399.         end;
  400.         Zout:=a;
  401.      END; {if Xrot <> 0 }
  402.  
  403.  
  404.  if (Zrot<>0) THEN
  405.      BEGIN
  406.         b:=lookup[Zrot,2];
  407.         c:=Xout;
  408.         asm
  409.           mov   ax,b
  410.           imul  c
  411.           sal   ax,1
  412.           rcl   dx,1
  413.           sal   ax,1
  414.           rcl   dx,1
  415.           mov   a,dx
  416.         end;
  417.         b:=lookup[Zrot,1];
  418.         c:=Yout;
  419.         asm
  420.           mov   ax,b
  421.           imul  c
  422.           sal   ax,1
  423.           rcl   dx,1
  424.           sal   ax,1
  425.           rcl   dx,1
  426.           sub   a,dx
  427.         end;
  428.         b:=lookup[Zrot,1];
  429.         c:=Xout;
  430.         Xout:=a;
  431.         asm
  432.           mov   ax,b
  433.           imul  c
  434.           sal   ax,1
  435.           rcl   dx,1
  436.           sal   ax,1
  437.           rcl   dx,1
  438.           mov   a,dx
  439.         end;
  440.         b:=lookup[Zrot,2];
  441.         c:=Yout;
  442.         asm
  443.           mov   ax,b
  444.           imul  c
  445.           sal   ax,1
  446.           rcl   dx,1
  447.           sal   ax,1
  448.           rcl   dx,1
  449.           add   a,dx
  450.         end;
  451.         Yout:=a;
  452.      END; {if Zrot <> 0 }
  453. END; {This one I grapped from some Asphyxia tuturial.... thnx Denthor }
  454.  
  455.  
  456. Procedure Init_Object;
  457. var
  458.  taeller : integer;
  459.  Ax,Ay,Az,Bx,By,Bz : integer;  {vectorer til beregning af normal}
  460.  Nx,Ny,Nz          : integer;  {normal-vectoren}
  461.  laengde,powers : real;
  462. begin
  463.   baseobj[1].X := -50;
  464.   baseobj[1].Y := -50;
  465.   baseobj[1].Z := -50;
  466.  
  467.   baseobj[2].X :=  50;
  468.   baseobj[2].Y := -50;
  469.   baseobj[2].Z := -50;
  470.  
  471.   baseobj[3].X := -50;
  472.   baseobj[3].Y :=  50;
  473.   baseobj[3].Z := -50;
  474.  
  475.   baseobj[4].X :=  50;
  476.   baseobj[4].Y :=  50;
  477.   baseobj[4].Z := -50;
  478.  
  479.   baseobj[5].X := -50;
  480.   baseobj[5].Y := -50;
  481.   baseobj[5].Z :=  50;
  482.  
  483.   baseobj[6].X :=  50;
  484.   baseobj[6].Y := -50;
  485.   baseobj[6].Z :=  50;
  486.  
  487.   baseobj[7].X := -50;
  488.   baseobj[7].Y :=  50;
  489.   baseobj[7].Z :=  50;
  490.  
  491.   baseobj[8].X :=  50;
  492.   baseobj[8].Y :=  50;
  493.   baseobj[8].Z :=  50;
  494.  
  495.   faces[1].P1 :=   1;
  496.   faces[1].P2 :=   2;
  497.   faces[1].P3 :=   4;
  498.   faces[1].P4 :=   3;
  499.  
  500.   faces[2].P1 :=   2;
  501.   faces[2].P2 :=   6;
  502.   faces[2].P3 :=   8;
  503.   faces[2].P4 :=   4;
  504.  
  505.   faces[3].P1 :=   5;
  506.   faces[3].P2 :=   7;
  507.   faces[3].P3 :=   8;
  508.   faces[3].P4 :=   6;
  509.  
  510.   faces[4].P1 :=   1;
  511.   faces[4].P2 :=   3;
  512.   faces[4].P3 :=   7;
  513.   faces[4].P4 :=   5;
  514.  
  515.   faces[5].P1 :=   1;
  516.   faces[5].P2 :=   5;
  517.   faces[5].P3 :=   6;
  518.   faces[5].P4 :=   2;
  519.  
  520.   faces[6].P1 :=   3;
  521.   faces[6].P2 :=   4;
  522.   faces[6].P3 :=   8;
  523.   faces[6].P4 :=   7;
  524.  
  525.   for taeller := 1 to Num_of_faces do
  526.      faces[taeller].color :=  0 + taeller * 2;
  527.  
  528.   for taeller := 1 to Num_of_faces do
  529.     begin
  530.       Ax := (baseobj[faces[taeller].P2].X - baseobj[faces[taeller].P1].X) div 10;
  531.       Ay := (baseobj[faces[taeller].P2].Y - baseobj[faces[taeller].P1].Y) div 10;
  532.       Az := (baseobj[faces[taeller].P2].Z - baseobj[faces[taeller].P1].Z) div 10;
  533.  
  534.       Bx := (baseobj[faces[taeller].P4].X - baseobj[faces[taeller].P1].X) div 10;
  535.       By := (baseobj[faces[taeller].P4].Y - baseobj[faces[taeller].P1].Y) div 10;
  536.       Bz := (baseobj[faces[taeller].P4].Z - baseobj[faces[taeller].P1].Z) div 10;
  537.  
  538.       Nx := (Ay*Bz) - (Az*By);
  539.       Ny := (Az*Bx) - (Ax*Bz);
  540.       Nz := (Ax*By) - (Ay*Bx);
  541.  
  542.       laengde := Sqrt(Nx*Nx + Ny*Ny + Nz*Nz);
  543.  
  544.  
  545.       normals[taeller].X := Round((Nx/laengde) * 256);
  546.       normals[taeller].Y := Round((Ny/laengde) * 256);
  547.       normals[taeller].Z := round((Nz/laengde) * 256);
  548.      end;
  549.      RotNormals := Normals;
  550. end;
  551.  
  552.  
  553.  
  554. Procedure HorLine(Xbegin, Xend,Ypos : integer;color : byte;where : word);
  555. Assembler;
  556. asm
  557.  mov cx,[Xend]
  558.  inc cx
  559.  sub cx,[Xbegin]   {cx = length of line - used for counter }
  560.                    {note, I assume that Xbegin < Xend - the poly routine}
  561.                    {will take care of that...}
  562.  mov ax,[ypos]
  563.  shl ax,8
  564.  mov di,ax
  565.  shr ax,2
  566.  add di,ax
  567.  add di,[Xbegin]   {di = Ypos * 320 + Xbegin - offset for our line}
  568.  mov es,[where]    {where to draw..}
  569.  
  570.  mov al,[color]
  571.  rep stosb         {I draw byte by byte - slower than drawing a word at a}
  572.                    {time but it is because of the changes we are going to}
  573.                    {make to this routine when glenzing/gouraud/texturemapping}
  574. end;
  575.  
  576.  
  577. PROCEDURE GouraudHorline(xbeg,xend,y:integer; c1,c2:byte;where : word);
  578. var coloradd : integer;
  579. begin
  580.  if (Xend-Xbeg) <> 0 then
  581.  coloradd := ((c2-c1) shl 8) div (Xend-Xbeg)
  582.  else coloradd := 0;
  583. asm
  584.   mov bx,[xbeg]
  585.   mov cx,[Xend]
  586.  
  587.   inc cx
  588.   sub cx,bx             { length of line in cx }
  589.   mov es,Where         { segment to draw in }
  590.   mov ax,[y]            { heigth of line }
  591.   shl ax,6
  592.   mov di,ax
  593.   shl ax,2
  594.   add di,ax             { y*320 in di (offset) }
  595.   add di,bx             { add x-begin }
  596.  
  597.   xor ax,ax
  598.   mov al,[C1]
  599.   shl ax,8              {colorstart fixed-p}
  600.  
  601.  @again:
  602.   mov es:[di],ah        {ah = real vaerdi af fixed-p color}
  603.   inc di
  604.   dec cx
  605.   add ax,[coloradd]
  606.   cmp cx,0
  607.   jne @again
  608.  @out:
  609. end;
  610. end;
  611.  
  612.  
  613. PROCEDURE TextureMapHorline(xbeg,xend,y,u1,v1,u2,v2:integer;source,dest : word);
  614. var
  615.   DeltaX : integer;
  616.   DeltaY : integer;
  617.  
  618. begin
  619.   If (Xend-Xbeg) <> 0 then
  620.    begin
  621.      DeltaX := ((u2-u1) shl 7) div (Xend-Xbeg);
  622.      DeltaY := ((v2-v1) shl 7) div (Xend-Xbeg);  { 9.7 fixed-p}
  623.      DeltaX := DeltaX + DeltaX;
  624.      DeltaY := DeltaY + DeltaY;                  {now 8.8 fixed-p :)  }
  625.    end
  626.     else
  627.    begin
  628.     DeltaX := 0;
  629.     DeltaY := 0;
  630.    end;
  631. asm
  632.   push ds
  633.   mov ax, [source]
  634.   mov ds,ax
  635.  
  636.   mov bx,[xbeg]
  637.   mov cx,[Xend]
  638.   inc cx
  639.   sub cx,bx            {cx =  length of line}
  640.  
  641.   mov es,dest
  642.   mov ax,[y]
  643.   shl ax,6
  644.   mov di,ax
  645.   shl ax,2
  646.   add di,ax
  647.   add di,bx           {es:[di] start of line}
  648.  
  649.   mov ah,byte[v1]   {8.8 fixed-p value of YTexturePos - for easy ofs calc}
  650.   mov al,byte[u1]
  651.   mov si,ax         {si = starting offset in texture }
  652.   mov dh,al         {8.8 fixed-p value of XTexturePos - for easy ofs calc}
  653.  
  654. @again:
  655.   movsb               {draw byte}
  656.   add ax,[DeltaY]     {advance in texturemap}
  657.   add dx,[DeltaX]     {advance in texturemap}
  658.  
  659.   mov bh,ah           {bh = Ypos * 256 }
  660.   mov bl,dh           {bl = Xpos_fixed / 256  = Xpos_real}
  661.   mov si,bx           {BX = Ypos_real * 256 + Xpos_real = offset}
  662.  
  663.   dec cx
  664.   cmp cx,0
  665.   jne @again          {are we finished ??  }
  666.  
  667.   pop ds
  668. end;
  669. end;
  670.  
  671.  
  672.  
  673. Procedure Polygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;color : byte; where : word);
  674. var
  675.  counter : integer;
  676.  Ymin, Ymax : integer;
  677.  polygon : Array[0..199,1..2] of integer;
  678.  
  679. Procedure ScanPolySide(X1,Y1,X2,Y2 : integer);
  680. var
  681.  DeltaX : integer;
  682.  temp : integer;
  683.  Xposfixed,Xpos : integer;
  684.  counter : integer;
  685. begin
  686.   if Y2=Y1 then exit;          {exit if side is a horizontal line }
  687.   if (Y2<Y1) then              {make sure Y1 is top point}
  688.                begin
  689.                  temp := Y1;
  690.                  Y1 := Y2;
  691.                  Y2 := temp;
  692.  
  693.                  temp := X1;
  694.                  X1 := X2;
  695.                  X2 := temp;   {switch the points if Y1 is not top..}
  696.                end;
  697.  
  698.   DeltaX := ((X2-X1) shl 7) div (Y2-Y1); {DeltaX in 9.7 fixed point math}
  699.   Xposfixed := X1 shl 7; {Xpos in 9.7 fixed point math }
  700.     for counter := Y1 to Y2 do
  701.          begin
  702.            Xpos := XposFixed shr 7;
  703.            if (Xpos < polygon[counter,1]) then polygon[counter,1] := Xpos;
  704.            if (Xpos > polygon[counter,2]) then polygon[counter,2] := Xpos;
  705.            Xposfixed := XposFixed + DeltaX;
  706.          end;
  707. end;
  708.  
  709.  
  710. begin
  711.  Ymin := Y1;
  712.  Ymax := Y1;
  713.  if (Y2 < Ymin) then Ymin := Y2;
  714.  if (Y2 > Ymax) then Ymax := Y2;
  715.  if (Y3 < Ymin) then Ymin := Y3;
  716.  if (Y3 > Ymax) then Ymax := Y3;
  717.  if (Y4 < Ymin) then Ymin := Y4;
  718.  if (Y4 > Ymax) then Ymax := Y4;  {what is Ymin and Ymax in this polygon ?}
  719.  
  720.  if (Ymin < 0) then Ymin := 0;
  721.  if (Ymax > 199) then Ymax := 199;
  722.  
  723.  for counter := 0 to 199 do
  724.    begin
  725.      polygon[counter,1] := 32000;
  726.      polygon[counter,2] := -32000;
  727.    end;
  728.  
  729.  {we have to initialize our variable 'polygon' to some extreme values}
  730.  
  731.  ScanPolySide(X1,Y1,X2,Y2);
  732.  ScanPolySide(X2,Y2,X3,Y3);
  733.  ScanPolySide(X3,Y3,X4,Y4);
  734.  ScanPolySide(X4,Y4,X1,Y1); {all four sides scanned}
  735.  
  736.  for counter := Ymin to Ymax do
  737.     Horline(polygon[counter,1],polygon[counter,2],counter,color,where);
  738. end;
  739.  
  740.  
  741.  
  742.  
  743. Procedure GouraudPolygon(x1,y1,x2,y2,x3,y3,x4,y4:integer;C1,C2,C3,C4:byte;where:word);
  744.   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  745.     in color col }
  746. var miny,maxy:integer;
  747.     loop1:integer;
  748.     poly : Array[0..199,1..2] of integer;
  749.     Colors : Array[0..199,1..2] of byte;
  750.  
  751. Procedure doside (x1,y1,x2,y2:integer;c1,c2 : byte);
  752.   { This scans the side of a polygon and updates the poly variable }
  753.   {updates the colors variable for gouraud shading}
  754. VAR temp:integer;
  755.     xfixed,xinc,x:integer;
  756.     loop1:integer;
  757.     dcol : integer;
  758.     color : integer;
  759. BEGIN
  760.   if y1=y2 then exit;
  761.   if y2<y1 then
  762.    BEGIN
  763.      temp:=y2;
  764.      y2:=y1;
  765.      y1:=temp;
  766.      temp:=x2;
  767.      x2:=x1;
  768.      x1:=temp;
  769.      temp := c2;
  770.      c2 := c1;
  771.      c1 := temp;
  772.    END;          {make sure y1 is top and y2 bottom}
  773.   dcol := ((c2-c1) shl 8) div (Y2-Y1);    {delta color pr. y-line}
  774.   color := c1 shl 8;      {startcolor i fixed-p}
  775.  
  776.   xinc:=((x2-x1) shl 7) div (y2-y1); {xinc in fixed point}
  777.   xfixed:=x1 shl 7;
  778.   for loop1:=y1 to y2 do BEGIN
  779.     if (loop1>(ytopclip)) and (loop1<(ybotclip)) then
  780.       BEGIN
  781.         x := xfixed shr 7;
  782.         if (x<poly[loop1,1]) then
  783.          begin
  784.            poly[loop1,1]:=x;
  785.            colors[loop1,1] := color shr 8;
  786.          end;
  787.         if (x>poly[loop1,2]) then
  788.          begin
  789.            poly[loop1,2]:=x;
  790.            colors[loop1,2] := color shr 8;
  791.          end;
  792.       END;
  793.     xfixed:=xfixed+xinc;
  794.     color := color + dcol;
  795.   END;
  796. END;
  797.  
  798. begin
  799.  for loop1 := 0 to 199 do
  800.   begin
  801.     poly[loop1,1] :=32766;
  802.     poly[loop1,2] :=-32767;
  803.   end;                      {set minx og maxx to extremes}
  804.  
  805.   miny:=y1;
  806.   maxy:=y1;
  807.   if y2<miny then miny:=y2;
  808.   if y3<miny then miny:=y3;
  809.   if y4<miny then miny:=y4;
  810.  
  811.   if y2>maxy then maxy:=y2;
  812.   if y3>maxy then maxy:=y3;
  813.   if y4>maxy then maxy:=y4;  {MinY and MaxY for drawing later on}
  814.  
  815.   if miny<ytopclip then miny:=ytopclip;
  816.   if maxy>ybotclip then maxy:=ybotclip;  {clipping}
  817.  
  818.   if (miny>199) or (maxy<0) then exit;  {is poly completely of screen?}
  819.  
  820.   Doside (x1,y1,x2,y2,c1,c2);
  821.  
  822.   Doside (x2,y2,x3,y3,c2,c3);
  823.   Doside (x3,y3,x4,y4,c3,c4);
  824.   Doside (x4,y4,x1,y1,c4,c1);  {scan each side and update poly-variable}
  825.  
  826.   for loop1:= miny to maxy do
  827.  
  828.     GouraudHorline (poly[loop1,1],poly[loop1,2],loop1,
  829.                     colors[loop1,1],colors[loop1,2],where);
  830. end;
  831.  
  832. Procedure TextureMapPolygon(x1,y1,x2,y2,x3,y3,x4,y4:integer;
  833.                             u1,v1,u2,v2,u3,v3,u4,v4: byte;source,dest:word);
  834. var miny,maxy:integer;
  835.     loop1:integer;
  836.     poly : Array[0..199,1..2] of integer;
  837.     Texture : Array[0..199,1..4] of byte;
  838.  
  839. Procedure doside (x1,y1,x2,y2:integer;u1,v1,u2,v2 : byte);
  840.   { This scans the side of a polygon and updates the poly variable }
  841.   {updates the textures variable for texturemapping}
  842. VAR temp:integer;
  843.     xfixed,xinc,x:integer;
  844.     loop1:integer;
  845.     dcol : integer;
  846.     deltaX, DeltaY : integer;
  847.     Xpos, Ypos : word;
  848.     color : integer;
  849. BEGIN
  850.   if y1=y2 then exit;
  851.   if y2<y1 then
  852.    BEGIN
  853.      temp:=y2;
  854.      y2:=y1;
  855.      y1:=temp;
  856.      temp:=x2;
  857.      x2:=x1;
  858.      x1:=temp;
  859.      temp := u2;
  860.      u2 := u1;
  861.      u1 := temp;
  862.      temp := v2;
  863.      v2 := v1;
  864.      v1 := temp;
  865.    END;          {make sure y1 is top and y2 bottom}
  866.  
  867.   DeltaX := ((u2-u1) shl 7) div (Y2-Y1);  {steps through texture in 9.7}
  868.   DeltaY := ((v2-v1) shl 7) div (Y2-Y1);  {fixed-point}
  869.   Xpos := u1 shl 7;
  870.   Ypos := v1 shl 7;     {starting texture positions}
  871.  
  872.   xinc:=((x2-x1) shl 7) div (y2-y1); {xinc in fixed point}
  873.   xfixed:=x1 shl 7;
  874.   for loop1:=y1 to y2 do BEGIN
  875.     if (loop1>(ytopclip)) and (loop1<(ybotclip)) then
  876.       BEGIN
  877.         x := xfixed shr 7;
  878.         if (x<poly[loop1,1]) then
  879.          begin
  880.            poly[loop1,1]:=x;
  881.            texture[loop1,1] := Xpos shr 7;
  882.            texture[loop1,2] := Ypos shr 7;
  883.          end;
  884.         if (x>poly[loop1,2]) then
  885.          begin
  886.            poly[loop1,2]:=x;
  887.            texture[loop1,3] := Xpos shr 7;
  888.            texture[loop1,4] := Ypos shr 7;
  889.          end;
  890.       END;
  891.     xfixed:=xfixed+xinc;
  892.     Xpos := Xpos + DeltaX;
  893.     Ypos := Ypos + DeltaY;
  894.   END;
  895. END;
  896.  
  897. begin
  898.  for loop1 := 0 to 199 do
  899.   begin
  900.     poly[loop1,1] :=32766;
  901.     poly[loop1,2] :=-32767;
  902.   end;                      {set minx og maxx to extremes}
  903.  
  904.   miny:=y1;
  905.   maxy:=y1;
  906.   if y2<miny then miny:=y2;
  907.   if y3<miny then miny:=y3;
  908.   if y4<miny then miny:=y4;
  909.  
  910.   if y2>maxy then maxy:=y2;
  911.   if y3>maxy then maxy:=y3;
  912.   if y4>maxy then maxy:=y4;  {MinY and MaxY for drawing later on}
  913.  
  914.   if miny<ytopclip then miny:=ytopclip;
  915.   if maxy>ybotclip then maxy:=ybotclip;  {clipping}
  916.  
  917.   if (miny>199) or (maxy<0) then exit;  {is poly completely of screen?}
  918.  
  919.   Doside (x1,y1,x2,y2,u1,v1,u2,v2);
  920.  
  921.   Doside (x2,y2,x3,y3,u2,v2,u3,v3);
  922.   Doside (x3,y3,x4,y4,u3,v3,u4,v4);
  923.   Doside (x4,y4,x1,y1,u4,v4,u1,v1); {scan each side and update poly-variable}
  924.  
  925.   for loop1:= miny to maxy do
  926.  
  927.     TextureMapHorline (poly[loop1,1],poly[loop1,2],loop1,
  928.                     texture[loop1,1],texture[loop1,2],
  929.                     texture[loop1,3],texture[loop1,4],source,dest);
  930.  
  931. end;
  932.  
  933.  
  934.  
  935.  
  936. Procedure Rotateobj(x,y,z : integer);
  937. {Rotates all points and calculates center Z-val for sorting}
  938. var
  939.  taeller : integer;
  940. begin
  941.  for taeller := 1 to num_of_points do
  942.   RotatePoint(x,y,z,baseobj[taeller].x,baseobj[taeller].y,baseobj[taeller].z,
  943.               points[taeller].x,points[taeller].y,points[taeller].z);
  944.  
  945.  
  946.  for taeller := 1 to num_of_faces do
  947.     centers[taeller] :=
  948.      (points[faces[taeller].P1].Z + points[faces[taeller].P2].Z +
  949.       points[faces[taeller].P3].Z + points[faces[taeller].P4].Z);
  950.     {average Z-val for face. NOTE : SHOULD divide by 4.. but that is really}
  951.     {not nessesary. This way all the values will be the correct val times 4}
  952.     {As ALL values is 4 times too big they will still sort correct :)      }
  953. end;
  954.  
  955.  
  956. Procedure RotateNormals(x,y,z : integer);
  957. {Roterer alle normals}
  958. var
  959.  taeller : integer;
  960. begin
  961.  for taeller := 1 to num_of_faces do
  962.   RotatePoint(x,y,z,normals[taeller].x,normals[taeller].y,normals[taeller].z,
  963.               RotNormals[taeller].x,RotNormals[taeller].y,RotNormals[taeller].z);
  964.  
  965.  
  966. end;
  967.  
  968.  
  969.  
  970. Procedure Sort_faces;
  971. {Just a simple bubble-sort - not to fast but what the heck :) }
  972. {Faces with the HIGHEST Z-val is placed first in Order[] }
  973. VAR
  974.   counter : integer;
  975.   position : integer;
  976.   tempval : integer;
  977. BEGIN
  978.   for counter:=1 to Num_of_faces do BEGIN
  979.     OrderTable[counter]:=counter;
  980.   END;
  981.   {we resets the ordertable so that it matches the unsorted 'centers' variable}
  982.   position := 1;
  983.  
  984.   repeat
  985.     if (centers[position] < centers[position+1]) then
  986.         BEGIN   {switch values in centers and ordertable}
  987.           tempval := Centers[position+1];
  988.           Centers[position+1] := centers[position];
  989.           centers[position] := tempval;
  990.  
  991.           tempval := OrderTable[position+1];
  992.           OrderTable[position+1] := OrderTable[position];
  993.           OrderTable[position] := tempval;
  994.  
  995.           position:=1;   {start loop over}
  996.         END;
  997.       inc(position);
  998.   until (position = Num_of_faces);  {all way through without changes}
  999. END;
  1000.  
  1001.  
  1002. Procedure Project_points;
  1003. var
  1004.  taeller : integer;
  1005. begin
  1006.  for taeller := 1 to Num_of_points do
  1007.     begin
  1008.       translated[taeller].X := Xconv(points[taeller].X,points[taeller].Z);
  1009.       translated[taeller].Y := Yconv(points[taeller].Y,points[taeller].Z);
  1010.      end;
  1011. end;
  1012.  
  1013.  
  1014. Procedure BadFlatShade(where : word; minZ, maxZ, Num_of_shades : integer);
  1015. {********************************************************************}
  1016. {**  MinZ, MaxZ : What is the minimum and maximum Z-values of the  **}
  1017. {**               faces that is to be drawn ? You COULD set theese **}
  1018. {**               values so that minZ is the minimum Z-val of the  **}
  1019. {**               entire object and MaxZ the maximum value. However**}
  1020. {**               consider the fact that half of the objects faces **}
  1021. {**               is removed by hidden face removal. So, if you    **}
  1022. {**               want to have bigger diference on the shown faces **}
  1023. {**               just set minZ to minimum object Z-value and MaxZ **}
  1024. {**               to the Z-value of the CENTER of the object.      **}
  1025. {**               Experiment!!                                     **}
  1026. {** Num_of_shades : shades used = color 0 to Num_of_shades         **}
  1027. {********************************************************************}
  1028.  
  1029. var
  1030.  taeller : integer;
  1031.  X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;
  1032.  color : byte;
  1033.  polynr : integer;
  1034.  normal,span : integer;
  1035.  shade : real;
  1036. begin
  1037.  for taeller := 1 to Num_of_faces do
  1038.    begin
  1039.      polynr := orderTable[taeller];
  1040.      X1 := translated[faces[polynr].P1].X;
  1041.      Y1 := translated[faces[polynr].P1].Y;
  1042.      X2 := translated[faces[polynr].P2].X;
  1043.      Y2 := translated[faces[polynr].P2].Y;
  1044.      X3 := translated[faces[polynr].P3].X;
  1045.      Y3 := translated[faces[polynr].P3].Y;
  1046.      X4 := translated[faces[polynr].P4].X;
  1047.      Y4 := translated[faces[polynr].P4].Y;
  1048.  
  1049.      {***************** Z-shading *****************}
  1050.  
  1051.      span := ABS (minZ-maxZ);   {Z span of object}
  1052.      shade := (centers[taeller] div 4 + ABS(minZ)) / span;
  1053.  
  1054.      color := Num_of_shades - round(Num_of_shades*shade);
  1055.  
  1056.      {*******************************************************}
  1057.      {******* HIDDEN FACE REMOVAL - YES, THAT EASY ;) *******}
  1058.      {*******************************************************}
  1059.      {Z-Comp of normal to 2d-polygon}
  1060.      normal := (Y1-Y3)*(X2-X1) - (X1-X3)*(Y2-Y1);
  1061.        if (normal < 0) then {pointing towards us}
  1062.          Polygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4,color,where);
  1063.      {*******************************************************}
  1064.      {*******************************************************}
  1065.      {*******************************************************}
  1066.    end;
  1067. end;
  1068.  
  1069.  
  1070. Procedure NiceFlatShade(where : word; Num_of_shades : integer);
  1071. var
  1072.  taeller : integer;
  1073.  X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;
  1074.  color : byte;
  1075.  polynr : integer;
  1076.  normal : integer;
  1077.  shade : real;
  1078.  Nx,Ny,Nz : real;
  1079.  dot : real;
  1080.  
  1081. begin
  1082.  for taeller := 1 to Num_of_faces do
  1083.    begin
  1084.      polynr := orderTable[taeller];
  1085.      X1 := translated[faces[polynr].P1].X;
  1086.      Y1 := translated[faces[polynr].P1].Y;
  1087.      X2 := translated[faces[polynr].P2].X;
  1088.      Y2 := translated[faces[polynr].P2].Y;
  1089.      X3 := translated[faces[polynr].P3].X;
  1090.      Y3 := translated[faces[polynr].P3].Y;
  1091.      X4 := translated[faces[polynr].P4].X;
  1092.      Y4 := translated[faces[polynr].P4].Y;
  1093.  
  1094.  
  1095.      {*******************************************************}
  1096.      {******* HIDDEN FACE REMOVAL - YES, THAT EASY ;) *******}
  1097.      {*******************************************************}
  1098.      {Z-Comp of normal to 2d-polygon}
  1099.      normal := (Y1-Y3)*(X2-X1) - (X1-X3)*(Y2-Y1);
  1100.  
  1101.  
  1102.        if (Normal < 0) then {pointing towards us}
  1103.          begin
  1104.            {************************************************************}
  1105.            {**   LAMBERTS FLATSHADIG ACCORDING TO MOVING LIGHTSOURCE  **}
  1106.            {************************************************************}
  1107.  
  1108.            Nx := RotNormals[polynr].X / 256;
  1109.            Ny := RotNormals[polynr].Y / 256;
  1110.            Nz := RotNormals[polynr].Z / 256;
  1111.  
  1112.           dot := (Nx*Lightvect.X) + (Ny*Lightvect.Y) + (Nz*Lightvect.Z);
  1113.           if (dot > 1) or (dot < 0) then dot := 0;
  1114.           color := Round(dot * Num_of_shades);
  1115.           Polygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4,color,where);
  1116.          end;
  1117.      {*******************************************************}
  1118.      {*******************************************************}
  1119.      {*******************************************************}
  1120.    end;
  1121. end;
  1122.  
  1123.  
  1124. Procedure GouraudShade(where : word; Num_of_shades : integer);
  1125. var
  1126.  taeller : integer;
  1127.  X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;
  1128.  C1,C2,C3,C4 : byte;
  1129.  polynr : integer;
  1130.  normal : integer;
  1131.  shade : real;
  1132.  {Nx,Ny,Nz : real;}
  1133.  norm : RealPointT;
  1134.  dot : real;
  1135.  
  1136. begin
  1137.  for taeller := 1 to Num_of_faces do
  1138.    begin
  1139.      polynr := orderTable[taeller];
  1140.      X1 := translated[faces[polynr].P1].X;
  1141.      Y1 := translated[faces[polynr].P1].Y;
  1142.      X2 := translated[faces[polynr].P2].X;
  1143.      Y2 := translated[faces[polynr].P2].Y;
  1144.      X3 := translated[faces[polynr].P3].X;
  1145.      Y3 := translated[faces[polynr].P3].Y;
  1146.      X4 := translated[faces[polynr].P4].X;
  1147.      Y4 := translated[faces[polynr].P4].Y;
  1148.  
  1149.  
  1150.      {*******************************************************}
  1151.      {******* HIDDEN FACE REMOVAL - YES, THAT EASY ;) *******}
  1152.      {*******************************************************}
  1153.      {Z-Comp of normal to 2d-polygon}
  1154.      normal := (Y1-Y3)*(X2-X1) - (X1-X3)*(Y2-Y1);
  1155.        if (normal < 0) then {pointing towards us}
  1156.          begin
  1157.            {************************************************************}
  1158.            {**   GOURAUD SHADING ACCORDING TO MOVING LIGHTSOURCE      **}
  1159.            {************************************************************}
  1160.  
  1161.           PointNormal(faces[polynr].P1,norm);
  1162.           dot := (norm.x*Lightvect.X) + (Norm.y*Lightvect.Y) + (Norm.z*Lightvect.Z);
  1163.           if (dot > 1) then dot := 1;
  1164.           if (dot < 0) then dot := 0;
  1165.           C1 := Round(dot * Num_of_shades);
  1166.  
  1167.           PointNormal(faces[polynr].P2,norm);
  1168.           dot := (norm.x*Lightvect.X) + (Norm.y*Lightvect.Y) + (Norm.z*Lightvect.Z);
  1169.           if (dot > 1) or (dot < 0) then dot := 0;
  1170.           C2 := Round(dot * Num_of_shades);
  1171.  
  1172.           PointNormal(faces[polynr].P3,norm);
  1173.           dot := (norm.x*Lightvect.X) + (Norm.y*Lightvect.Y) + (Norm.z*Lightvect.Z);
  1174.           if (dot > 1) or (dot < 0) then dot := 0;
  1175.           C3 := Round(dot * Num_of_shades);
  1176.  
  1177.           PointNormal(faces[polynr].P4,norm);
  1178.           dot := (norm.x*Lightvect.X) + (Norm.y*Lightvect.Y) + (Norm.z*Lightvect.Z);
  1179.           if (dot > 1) or (dot < 0) then dot := 0;
  1180.           C4 := Round(dot * Num_of_shades);
  1181.  
  1182.  
  1183.           GouraudPolygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4,c1,c2,c3,c4,where);
  1184.          end;
  1185.      {*******************************************************}
  1186.      {*******************************************************}
  1187.      {*******************************************************}
  1188.    end;
  1189. end;
  1190.  
  1191.  
  1192. PROCEDURE EnvironmentMap(source,dest : word);
  1193. var
  1194.  taeller : integer;
  1195.  X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;
  1196.  U1,V1,U2,V2,U3,V3,U4,V4 : integer;
  1197.  polynr : integer;
  1198.  normal : integer;
  1199.  norm : PointT;
  1200.  
  1201. begin
  1202.  for taeller := 1 to Num_of_faces do
  1203.    begin
  1204.      polynr := orderTable[taeller];
  1205.      X1 := translated[faces[polynr].P1].X;
  1206.      Y1 := translated[faces[polynr].P1].Y;
  1207.      X2 := translated[faces[polynr].P2].X;
  1208.      Y2 := translated[faces[polynr].P2].Y;
  1209.      X3 := translated[faces[polynr].P3].X;
  1210.      Y3 := translated[faces[polynr].P3].Y;
  1211.      X4 := translated[faces[polynr].P4].X;
  1212.      Y4 := translated[faces[polynr].P4].Y;
  1213.  
  1214.  
  1215.      {*******************************************************}
  1216.      {******* HIDDEN FACE REMOVAL - YES, THAT EASY ;) *******}
  1217.      {*******************************************************}
  1218.      {Z-Comp of normal to 2d-polygon}
  1219.      normal := (Y1-Y3)*(X2-X1) - (X1-X3)*(Y2-Y1);
  1220.        if (normal < 0) then {pointing towards us}
  1221.          begin
  1222.            {************************************************************}
  1223.            {**           ENVIRONMENT MAPPING / FAKE PHONG             **}
  1224.            {************************************************************}
  1225.  
  1226.           FixedPointNormal(faces[polynr].P1,norm);
  1227.           u1 := (norm.X div 2) + 128;
  1228.           v1 := (norm.Y div 2) + 128;
  1229.  
  1230.           FixedPointNormal(faces[polynr].P2,norm);
  1231.           u2 := (norm.X div 2) + 128;
  1232.           v2 := (norm.Y div 2) + 128;
  1233.  
  1234.           FixedPointNormal(faces[polynr].P3,norm);
  1235.           u3 := (norm.X div 2) + 128;
  1236.           v3 := (norm.Y div 2) + 128;
  1237.  
  1238.           FixedPointNormal(faces[polynr].P4,norm);
  1239.           u4 := (norm.X div 2) + 128;
  1240.           v4 := (norm.Y div 2) + 128;
  1241.  
  1242.           TexturemapPolygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4,
  1243.                             u1,v1,u2,v2,u3,v3,u4,v4,source,dest);
  1244.          end;
  1245.      {*******************************************************}
  1246.      {*******************************************************}
  1247.      {*******************************************************}
  1248.    end;
  1249. end;
  1250.  
  1251.  
  1252. Procedure SetLightSource(Xbeg,Ybeg,Zbeg,Xend,Yend,Zend : integer);
  1253. var
  1254.  lenght : real;
  1255.  Ax, Ay, Az : integer;
  1256. begin
  1257.   Ax := Xend - Xbeg;
  1258.   Ay := Yend - Ybeg;
  1259.   Az := Zend - Zbeg;   {vector from lightsource to lightdest}
  1260.   lenght := sqrt(Ax*Ax + Ay*Ay + Az*Az);
  1261.   lightvect.X := Ax/lenght;
  1262.   lightvect.Y := Ay/lenght;
  1263.   lightvect.Z := Az/lenght;
  1264. end;
  1265.  
  1266.  
  1267.  
  1268. Procedure TexturemapCube(source,outp : word);
  1269. {This one can be used for all kinds of fills : solid, textures, glenz...}
  1270. var
  1271.  taeller : integer;
  1272.  X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;
  1273.  color : byte;
  1274.  polynr : integer;
  1275.  normal : integer;
  1276. begin
  1277.  for taeller := 1 to Num_of_faces do
  1278.    begin
  1279.      polynr := orderTable[taeller];
  1280.      X1 := translated[faces[polynr].P1].X;
  1281.      Y1 := translated[faces[polynr].P1].Y;
  1282.      X2 := translated[faces[polynr].P2].X;
  1283.      Y2 := translated[faces[polynr].P2].Y;
  1284.      X3 := translated[faces[polynr].P3].X;
  1285.      Y3 := translated[faces[polynr].P3].Y;
  1286.      X4 := translated[faces[polynr].P4].X;
  1287.      Y4 := translated[faces[polynr].P4].Y;
  1288.      color := faces[polynr].color;
  1289.  
  1290.      {*******************************************************}
  1291.      {******* HIDDEN FACE REMOVAL - YES, THAT EASY ;) *******}
  1292.      {*******************************************************}
  1293.      {Z-Comp of normal}
  1294.      normal := (Y1-Y3)*(X2-X1) - (X1-X3)*(Y2-Y1);
  1295.        if (normal < 0) then
  1296.          TextureMapPolygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4,
  1297.                   0,0,255,0,255,255,0,255,source,outp);
  1298.  
  1299.      {*******************************************************}
  1300.      {*******************************************************}
  1301.      {*******************************************************}
  1302.  
  1303.    end;
  1304. end;
  1305.  
  1306.  
  1307.  
  1308.  
  1309.  
  1310.  
  1311. BEGIN
  1312.  
  1313.  
  1314.  
  1315. Clrscr;
  1316. Writeln('      ****************************************************************');
  1317. Writeln('      *                                                              *');
  1318. Writeln('      *                 3D OBJECT ENGINE - THE FILLS                 *');
  1319. Writeln('      *                        by : Telemachos                       *');
  1320. Writeln('      *                                                              *');
  1321. Writeln('      ****************************************************************');
  1322. Writeln;
  1323. Writeln('      Hiya! ');
  1324. Writeln('      Welcome to the Peroxide Programming Tips #4');
  1325. Writeln('      This one is on 3D objects - showing you how to shade those nice');
  1326. Writeln('      3d objects you have been making since the last tut :)');
  1327. Writeln('      This small demo contains five small parts. ');
  1328. Writeln('                                                                      ');
  1329. Writeln('         1) Bad Z-shading                      ');
  1330. Writeln('         2) Nice Flat shading according to lightsource');
  1331. Writeln('         3) Gouraud shaded cube according to lightsource..');
  1332. Writeln('         4) Texturemapped Cube - I will just use the entire phong map as texture');
  1333. Writeln('         5) Environmentmapping / FakePhong ');
  1334. Writeln;
  1335. Writeln('         Hit any key to switch between them....');
  1336. Writeln;
  1337. Writeln('      Calculating Phong map.. this may take a while...');
  1338.  
  1339. SetUpSegment(TexSegment,Texture);
  1340. CalcFakePhongMap(texture);
  1341.  
  1342. Writeln('      Done... hit any key to start');
  1343.  
  1344. readkey;
  1345.  
  1346.  asm
  1347.    mov ax,13h
  1348.    int 10h
  1349.  end;
  1350.  
  1351. Calc_cos_sin;
  1352. Init_Object;
  1353.  
  1354. Clear(0,VGA);
  1355. SetUpVirtual(scr2,vaddr);
  1356.  
  1357. Xrot := 0;
  1358. Yrot := 0;
  1359. Zrot := 0;
  1360.  
  1361. SetlightSource(0,0,-100,0,0,0); {peger nu lige ind i skaermen}
  1362.  
  1363. GreyScale;
  1364.  
  1365. repeat
  1366.  Rotateobj(Xrot,Yrot,Zrot);
  1367.  RotateNormals(Xrot,Yrot,Zrot);
  1368.  
  1369.  Xrot := (Xrot + 1) mod 360;
  1370.  Yrot := (Yrot + 3) mod 360;
  1371.  Zrot := (Zrot + 1) mod 360;
  1372.  Clear(0,Vaddr);
  1373.  
  1374.  
  1375.  Project_Points;
  1376.  Sort_faces;
  1377.  Clear(0,Vaddr);
  1378.  
  1379.  
  1380.  BadFlatShade(vaddr,-50,20,20);
  1381.  
  1382.  waitretrace;
  1383.  FlipScreen(vaddr,VGA);
  1384.  
  1385. until keypressed;
  1386. readkey;
  1387.  
  1388. repeat
  1389.  Rotateobj(Xrot,Yrot,Zrot);
  1390.  RotateNormals(Xrot,Yrot,Zrot);
  1391.  
  1392.  Xrot := (Xrot + 1) mod 360;
  1393.  Yrot := (Yrot + 3) mod 360;
  1394.  Zrot := (Zrot + 1) mod 360;
  1395.  Clear(0,Vaddr);
  1396.  
  1397.  
  1398.  Project_Points;
  1399.  Sort_faces;
  1400.  Clear(0,Vaddr);
  1401.  
  1402.  
  1403.  NiceFlatShade(vaddr,30);
  1404.  
  1405.  waitretrace;
  1406.  FlipScreen(vaddr,VGA);
  1407.  
  1408. until keypressed;
  1409. readkey;
  1410.  
  1411. PurplePal;
  1412.  
  1413. repeat
  1414.  Rotateobj(Xrot,Yrot,Zrot);
  1415.  RotateNormals(Xrot,Yrot,Zrot);
  1416.  
  1417.  Xrot := (Xrot + 1) mod 360;
  1418.  Yrot := (Yrot + 3) mod 360;
  1419.  Zrot := (Zrot + 1) mod 360;
  1420.  Clear(0,Vaddr);
  1421.  
  1422.  
  1423.  Project_Points;
  1424.  Sort_faces;
  1425.  Clear(0,Vaddr);
  1426.  
  1427.  
  1428.  GouraudShade(vaddr,63);
  1429.  
  1430.  waitretrace;
  1431.  FlipScreen(vaddr,VGA);
  1432.  
  1433. until keypressed;
  1434. readkey;
  1435.  
  1436.  
  1437. FakePhongPal;
  1438.  
  1439. repeat
  1440.  Rotateobj(Xrot,Yrot,Zrot);
  1441.  RotateNormals(Xrot,Yrot,Zrot);
  1442.  
  1443.  Xrot := (Xrot + 1) mod 360;
  1444.  Yrot := (Yrot + 3) mod 360;
  1445.  Zrot := (Zrot + 1) mod 360;
  1446.  Clear(0,Vaddr);
  1447.  
  1448.  
  1449.  Project_Points;
  1450.  Sort_faces;
  1451.  Clear(0,Vaddr);
  1452.  
  1453.  TextureMapCube(texture,vaddr);
  1454.  
  1455.  waitretrace;
  1456.  FlipScreen(vaddr,VGA);
  1457.  
  1458. until keypressed;
  1459. readkey;
  1460.  
  1461.  
  1462. repeat
  1463.  Rotateobj(Xrot,Yrot,Zrot);
  1464.  RotateNormals(Xrot,Yrot,Zrot);
  1465.  
  1466.  Xrot := (Xrot + 1) mod 360;
  1467.  Yrot := (Yrot + 3) mod 360;
  1468.  Zrot := (Zrot + 1) mod 360;
  1469.  Clear(0,Vaddr);
  1470.  
  1471.  
  1472.  Project_Points;
  1473.  Sort_faces;
  1474.  Clear(0,Vaddr);
  1475.  
  1476.  Environmentmap(texture,vaddr);
  1477.  
  1478.  waitretrace;
  1479.  FlipScreen(vaddr,VGA);
  1480.  
  1481. until keypressed;
  1482. readkey;
  1483.  
  1484.  
  1485.  
  1486. ShutDown(scr2);
  1487.  
  1488. asm
  1489.  mov ax,03h
  1490.  int 10h
  1491. end;
  1492.  
  1493. END.
  1494.  
  1495.