{$A+,B-,E+,F-,G+,N+,Q-,R-,S-}

Program polys3d;

{
   originaly... Programmed by Ryan Jones (Dios@Rworld.com)
}

Uses crush13h,CRT;

Const
        ZInc = 25;
        ZOfs = 256;
        ZScale = 256;
        Sc = 0.7;


type verts= record
                   x,y,z:real;
                   color:integer;
            end;
     lines= record
                   v1,v2:word;
                   color:integer;
            end;

Var     Vert : Array[0..100] Of verts;
        VLine : Array[0..100] Of lines;
        Vertn,linen,n:word;
        Ch : Char;
        a:integer;
        ang: real;

Procedure Drawverts (where:word);
Var SX, SY, n : Word;
Begin
     n := 0;
     Repeat
           With Vert[n] Do
                 Begin
                         SX := Round((ZScale*X)/(Z-ZOfs));
                         SY := Round((ZScale*Y)/(Z-ZOfs));
                         {Color := round(abs(z));}
                         if 160+sx>-1 then if 160+sx<320 then if 100+sy>-1 then if 100+sy<200 then
                            putpixel (160+SX, 100+SY, color, where);


                 End;
           n := n + 1;
     Until n = Vertn;
End;

Procedure Drawlines (where:word);
Var SX1, SY1, SX2, SY2, n : Word;
Begin
     n := 0;
     Repeat
           SX1 := Round((ZScale*vert[vline[n].v1].x)/(vert[vline[n].v1].Z-ZOfs));
           SY1 := Round((ZScale*vert[vline[n].v1].Y)/(vert[vline[n].v1].Z-ZOfs));
           SX2 := Round((ZScale*vert[vline[n].v2].X)/(vert[vline[n].v2].Z-ZOfs));
           SY2 := Round((ZScale*vert[vline[n].v2].Y)/(vert[vline[n].v2].Z-ZOfs));
           {vline[n].color:=round((Vert[vline[n].v1].color+Vert[vline[n].v2].color)/2);}
           line (160+SX1, 100+SY1, 160+SX2, 100+SY2, vline[n].color, where);
           n := n + 1;
     Until n = linen;
End;

Procedure Rotate(Var X, Y, ang : Real);
        Var XX, YY : Real;
        Begin
           XX := X*Cos(ang)+Y*Sin(ang);
      YY := Y*Cos(ang)-X*Sin(ang);
      X := XX;
      Y := YY;
   End;

Procedure RotateVertsy(n:word;ang : Real);
begin
     With Vert[n] Do Rotate(X, Z, ang);
End;

Procedure RotateVertsz(ang : Real);
        Var n : Word;
        Begin
           n := 0;
      Repeat
              With Vert[n] Do Rotate(X, Y, ang);
              n := n + 1;
      Until n = Vertn;
   End;

Procedure RotateVertsx(ang : Real);
        Var n : Word;
        Begin
           n := 0;
      Repeat
              With Vert[n] Do Rotate(Y, Z, ang);
              n := n + 1;
      Until n = Vertn;
   End;

Procedure ExpandVerts (scd:real);
Var n : Word;
Begin
           n := 0;
      Repeat
              With Vert[n] Do
                 Begin
                    X := X * Scd;
                    Y := Y * Scd;
            End;
         n := n + 1;
      Until n = Vertn;
End;

Begin
     video_mode( $13);
     initvirt;
      With Vert[0] Do
           Begin
              X := 100;
              Y := 86;
              Z := 0;
                   X := X * Sc;
                   Y := Y * Sc;
                   Z := Z * Sc;
                   {Color := round(abs(z));}
                   color:=250;
           end;
      With Vert[1] Do
           begin
              X := 100;
              Y := -86;
              Z := 0;
                   X := X * Sc;
                   Y := Y * Sc;
                   Z := Z * Sc;
                   {Color := round(abs(z));}
                   color:=250;
           end;
      With Vert[2] Do
           begin
              X := -100;
              Y := -86;
              Z := 0;
                   X := X * Sc;
                   Y := Y * Sc;
                   Z := Z * Sc;
                   {Color := round(abs(z));}
                   color:=250;
           end;
      With Vert[3] Do
           begin
              X := -100;
              Y := 86;
              Z := 0;
                   X := X * Sc;
                   Y := Y * Sc;
                   Z := Z * Sc;
                   {Color := round(abs(z));}
                   color:=250;
           End;

      vline[0].v1:=0;
      vline[0].v2:=1;
      vline[0].color:=round((Vert[vline[0].v1].color+Vert[vline[0].v2].color)/2);

      vline[1].v1:=1;
      vline[1].v2:=2;
      vline[1].color:=round((Vert[vline[1].v1].color+Vert[vline[1].v2].color)/2);

      vline[2].v1:=2;
      vline[2].v2:=3;
      vline[2].color:=round((Vert[vline[2].v1].color+Vert[vline[2].v2].color)/2);

      vline[3].v1:=3;
      vline[3].v2:=0;
      vline[3].color:=round((Vert[vline[3].v1].color+Vert[vline[3].v2].color)/2);

   Vertn := 4;
   linen := 4;
   loadpcx ('c:\ps\neopaint\pcx\moia95_2.pcx',vp[2]);
   ang:= Pi/72;


   Repeat
              cls (0,vp[1]);
              DrawVerts(vp[1]);
              drawlines(vp[1]);
              for a:=0 to 256 do putpixel (a,0,a,vp[1]);
              waitvbl;
              move (mem[vp[1]:0],mem[vga:0],64000);

              for a:=0 to vertn do
              begin
                   With Vert[a] Do Rotate(X, Z, ang);
                   With Vert[a] Do Rotate(Y, X, ang);
                   {With Vert[a] Do Rotate(Z, Y, ang);}
              end;

   Until KeyPressed;

   Repeat Ch := ReadKey Until Not KeyPressed;
   n := 150;
   Repeat
      cls (0,vp[1]);
      DrawVerts(vp[1]);
      Drawlines(vp[1]);
      move (mem[vp[1]:0],mem[vga:0],64000);
      ExpandVerts(0.95);            {shrinks couz value is <0}
      for a:=0 to vertn do
              begin
                   With Vert[a] Do Rotate(X, Z, ang);
                   With Vert[a] Do Rotate(Y, X, ang);
                   With Vert[a] Do Rotate(Z, Y, ang);
              end;

      n := n - 1;
   Until (n = 0) Or KeyPressed;
   If KeyPressed Then Repeat Ch := ReadKey Until Not KeyPressed;

   Video_Mode( 03);
End.