[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{ 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
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]