
{ Here is a program to rotate any object in 3D. }

(********************************************************
 * This program was written by David Rozenberg          *
 *                                                      *
 * The program show how to convert a 3D point into a 2D *
 * plane like the computer screen. So it will give you  *
 * the illusion of 3D shape.                            *
 *                                                      *
 * You can rotate it by the keyboard arrows, for nonstop*
 * rotate press Shift+Arrow                             *
 *                                                      *
 * Please use the program as it is without changing it. *
 *                                                      *
 * Usage:                                               *
 *   3D FileName.Ext                                    *
 *                                                      *
 * There are some files for example how to build them   *
 * the header " ; 3D by David Rozenberg " must be at the*
 * beging of the file.                                  *
 *                                                      *
 ********************************************************)

Program G3d;
{$E+,N+}
Uses
 Crt,Graph;

Type
  Coordinate = Array[1..7] of Real;
  Point = Record
            X,Y,Z : Real;
          End;
  LineRec = ^LineType;
  LineType = Record
               FPoint,TPoint : Point;
               Color : Byte;
               Next  : LineRec;
             End;


Var
  FirstLine : LineRec;
  Last      : LineRec;

Procedure Init;
Var
  GraphDriver,GraphMode,GraphError : Integer;

Begin
  GraphDriver:=Detect;
  initGraph(GraphDriver,GraphMode,'\turbo\tp');  { your BGI driver address }
  GraphError:=GraphResult;
  if GraphError<>GrOk then begin
    clrscr;
    writeln('Error while turning to graphics mode.');
    writeln;
    halt(2);
  end;
End;


Function DegTRad(Deg : Real) : real;
Begin
  DegTRad:=Deg/180*Pi;
End;

Procedure ConvertPoint (P : Point;Var X,Y : Integer);
Var
  Dx,Dy : Real;

Begin
  X:=GetMaxX Div 2;
  Y:=GetMaxY Div 2;
  Dx:=(P.Y)*cos(pi/6);
  Dy:=-(P.Y)*Sin(Pi/6);
  Dx:=Dx+(P.X)*Cos(pi/3);
  Dy:=Dy+(P.X)*Sin(Pi/3);
  Dy:=Dy-P.Z;
  X:=X+Round(Dx);
  Y:=Y+Round(Dy);
End;

Procedure DrawLine(Lrec : LineRec);
Var
  Fx,Fy,Tx,Ty : Integer;

Begin
  SetColor(Lrec^.Color);
  ConvertPoint(LRec^.FPoint,Fx,Fy);
  ConvertPoint(LRec^.TPoint,Tx,Ty);
  Line(Fx,Fy,Tx,Ty);
End;

Procedure ShowLines;
Var
  Lp : LineRec;

Begin
  ClearDevice;
  Lp:=FirstLine;
  While Lp<>Nil do Begin
    DrawLine(Lp);
    Lp:=Lp^.Next;
  end;
End;

Procedure Error(Err : Byte;S : String);
Begin
  Clrscr;
  Writeln;
  Case Err of
    1 : Writeln('File : ',S,' not found!');
    2 : Writeln(S,' isn''t a 3d file!');
    3 : Writeln('Error in line :',S);
    4 : Writeln('No file was indicated');
  End;
  Writeln;
  Halt(Err);
End;

Procedure AddLine(Coord : Coordinate);
Var
  Lp : LineRec;

Begin
  New(Lp);
  Lp^.Color:=Round(Coord[7]);
  Lp^.FPoint.X:=Coord[1];
  Lp^.FPoint.Y:=Coord[2];
  Lp^.FPoint.Z:=Coord[3];
  Lp^.TPoint.X:=Coord[4];
  Lp^.TPoint.Y:=Coord[5];
  Lp^.TPoint.Z:=Coord[6];
  Lp^.Next:=Nil;
  If Last=Nil then FirstLine:=Lp else Last^.Next:=Lp;
  Last:=Lp;
end;

Procedure LoadFile(Name : String);
Var
  F : Text;
  Coord : Coordinate;
  S,S1 : String;
  I : Byte;
  LineNum : Word;
  Comma : Integer;

Begin
  FirstLine:=Nil;
  Last:=Nil;
  Assign(F,Name);
  {$I-}
  Reset(f);
  {$I+}
  If IoResult<>0 then Error(1,Name);
  Readln(F,S);
  If S<>'; 3D by David Rozenberg' then Error(2,Name);
  LineNum:=1;
  While Not Eof(F) do Begin
    Inc(LineNum);
    Readln(F,S);
    while Pos(' ',S)<>0 do Delete(S,Pos(' ',S),1);
    If (S<>'') and (S[1]<>';') then begin
      For I:=1 to 6 do Begin
        Comma:=Pos(',',S);
        If Comma=0 then Begin
          Close(F);
          Str(LineNum:4,S);
          Error(3,S);
        End;
        S1:=Copy(S,1,Comma-1);
        Delete(S,1,Comma);
        Val(S1,Coord[i],Comma);
        If Comma<>0 then Begin
          Close(F);
          Str(LineNum:4,S);
          Error(3,S);
        End;
      End;
      Val(S,Coord[7],Comma);
      If Comma<>0 then Begin
        Close(F);
        Str(LineNum:4,S);
        Error(3,S);
      End;
      AddLine(Coord);
    End;
  End;
  Close(F);
End;

Procedure RotateZ(Deg : Real);
Var
  Lp : LineRec;
  Rad : Real;
  Tx,Ty : Real;

Begin
  Rad:=DegTRad(Deg);
  Lp:=FirstLine;
  While Lp<>Nil do Begin
    With Lp^.Fpoint Do Begin
      TX:=(X*Cos(Rad)-Y*Sin(Rad));
      TY:=(X*Sin(Rad)+Y*Cos(Rad));
      X:=Tx;
      Y:=Ty;
    End;
    With Lp^.Tpoint Do Begin
      TX:=(X*Cos(Rad)-Y*Sin(Rad));
      TY:=(X*Sin(Rad)+Y*Cos(Rad));
      X:=Tx;
      Y:=Ty;
    End;
    Lp:=Lp^.Next;
  end;
End;

Procedure RotateY(Deg : Real);
Var
  Lp : LineRec;
  Rad : Real;
  Tx,Tz : Real;

Begin
  Rad:=DegTRad(Deg);
  Lp:=FirstLine;
  While Lp<>Nil do Begin
    With Lp^.Fpoint Do Begin
      TX:=(X*Cos(Rad)-Z*Sin(Rad));
      TZ:=(X*Sin(Rad)+Z*Cos(Rad));
      X:=Tx;
      Z:=Tz;
    End;
    With Lp^.Tpoint Do Begin
      TX:=(X*Cos(Rad)-Z*Sin(Rad));
      TZ:=(X*Sin(Rad)+Z*Cos(Rad));
      X:=Tx;
      Z:=Tz;
    End;
    Lp:=Lp^.Next;
  end;
End;

Procedure Rotate;
Var
  Ch : Char;

Begin
  Repeat
    Repeat
      Ch:=Readkey;
      If ch=#0 then Ch:=Readkey;
    Until Ch in [#27,#72,#75,#77,#80,#50,#52,#54,#56];
    Case ch of
      #54 :Begin
              While Not keypressed do begin
                RotateZ(10);
                ShowLines;
                Delay(100);
              End;
              Ch:=Readkey;
              If Ch=#0 then Ch:=ReadKey;
            End;
      #52:Begin
              While Not keypressed do begin
                RotateZ(-10);
                ShowLines;
                Delay(100);
              End;
              Ch:=Readkey;
              If Ch=#0 then Ch:=ReadKey;
            End;
      #56:Begin
              While Not keypressed do begin
                RotateY(10);
                ShowLines;
                Delay(100);
              End;
              Ch:=Readkey;
              If Ch=#0 then Ch:=ReadKey;
            End;
      #50:Begin
              While Not keypressed do begin
                RotateY(-10);
                ShowLines;
                Delay(100);
              End;
              Ch:=Readkey;
              If Ch=#0 then Ch:=ReadKey;
            End;
      #72 : Begin
              RotateY(10);
              ShowLines;
            End;
      #75 : Begin
              RotateZ(-10);
              ShowLines;
            End;
      #77 : Begin
              RotateZ(10);
              ShowLines;
            End;
      #80 : Begin
              RotateY(-10);
              ShowLines;
            End;
    End;
  Until Ch=#27;
End;

Begin
  If ParamCount<1 then Error(4,'');
  LoadFile(ParamStr(1));
  Init;
  ShowLines;
  Rotate;
  CloseGraph;
  ClrScr;
  Writeln;
  Writeln('Thanks for using 3D');
  Writeln;
End.

There is sample of some files that can be rotated:
cut out and save in specified file name
Cube.3D:

; 3D by David Rozenberg
; Base of cube
-70,70,-70,70,70,-70,15
70,70,-70,70,-70,-70,15
70,-70,-70,-70,-70,-70,15
-70,-70,-70,-70,70,-70,15
; Top of cube
-70,70,70,70,70,70,15
70,70,70,70,-70,70,15
70,-70,70,-70,-70,70,15
-70,-70,70,-70,70,70,15
; Side of cube
-70,70,-70,-70,70,70,13
70,70,-70,70,70,70,13
70,-70,-70,70,-70,70,13
-70,-70,-70,-70,-70,70,13

David.3D:

; 3D by David Rozenberg
0,-120,45,0,-30,45,15
0,-60,45,0,-60,-45,15
; 
0,-15,45,0,15,45,12
0,15,45,0,15,-45,12
;
0,30,45,0,120,45,11
0,90,45,0,90,-45,11
;
50,-45,-75,50,45,-75,10
50,45,-75,50,45,-165,10

