home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / disk22 / cdemos / wire.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-04-14  |  2.5 KB  |  87 lines
  1. { Moving an object in 3D.                         }
  2. {                                                 }
  3. {                  by Crom / Spanish Lords Feb 96 }
  4. Program Prueba3D;
  5.  
  6. Uses
  7.   Crt,Memory,donut,DemoVga,Lib3D_v2;
  8.  
  9. Const
  10.   NumPoints = High (Points);
  11.  
  12. Var
  13. { Temporaly storage    }
  14.   Temp       : Array [0..NumPoints] of Point3D;
  15. { Are ESC key pressed? }
  16.   Tecla      : Char;
  17. { Memory variables }
  18.   PtrBuffer  : Pointer;
  19.   SegBuffer  : Word;
  20. { One counter ;)       }
  21.   Cnt        : Word;
  22. { Rotations angles     }
  23.   XAngle     : Integer;
  24.   YAngle     : Integer;
  25.   ZAngle     : Integer;
  26. { Final points         }
  27.   Xf,Yf      : Word;
  28. { Point col.           }
  29.   Col        : Byte;
  30.  
  31. Procedure CreatePalette;
  32. Begin
  33.   For Cnt:=0  to 63 do PutColor (Cnt,Cnt,Cnt,0);
  34. End;
  35.  
  36. BEGIN
  37.   McgaOn;
  38.  
  39.   CreatePalette;
  40.  
  41.   XAngle:=   0;
  42.   YAngle:=   0;
  43.   ZAngle:=   0;
  44.   ZOrg  := 260;
  45.  
  46.   PtrBuffer:= MemAllocseg (64000);
  47.   SegBuffer:= Seg (PtrBuffer^);
  48.  
  49.   Repeat
  50.  
  51.     Fill64K (SegBuffer,0);
  52.     Calc3DRotations (FastSin(XAngle),FastCos(XAngle),
  53.                      FastSin(YAngle),FastCos(YAngle),
  54.                      FastSin(ZAngle),FastCos(ZAngle),
  55.                      Points,Temp,High(Points));
  56.     Proyect    (160,100,High(Points),Temp,Temp);
  57.     QuickSortZ (High(Faces),Temp,Faces);
  58.     For Cnt:=0 to High (Faces) do
  59.       Begin
  60.         If Visible (Temp [Faces[Cnt,1],1],Temp [Faces[Cnt,1],2],
  61.                     Temp [Faces[Cnt,2],1],Temp [Faces[Cnt,2],2],
  62.                     Temp [Faces[Cnt,3],1],Temp [Faces[Cnt,3],2]) then
  63.           Begin
  64.             DrawLine (SegBuffer,Temp [Faces[Cnt,1],1],Temp [Faces[Cnt,1],2],Temp [Faces[Cnt,2],1],Temp [Faces[Cnt,2],2],
  65.                       Temp [Faces[Cnt,1],3]shr 2+25);
  66.             DrawLine (SegBuffer,Temp [Faces[Cnt,1],1],Temp [Faces[Cnt,1],2],Temp [Faces[Cnt,3],1],Temp [Faces[Cnt,3],2],
  67.                       Temp [Faces[Cnt,1],3]shr 2+25);
  68.             DrawLine (SegBuffer,Temp [Faces[Cnt,2],1],Temp [Faces[Cnt,2],2],Temp [Faces[Cnt,3],1],Temp [Faces[Cnt,3],2],
  69.                       Temp [Faces[Cnt,1],3]shr 2+25);
  70.           End;
  71.       End;
  72.     VerticalRetrace;
  73.     Copy64K (SegBuffer,$A000);
  74.     Inc (XAngle,10);
  75.     If   XAngle>1024 then XAngle:=XAngle-1024;
  76.     Inc (YAngle,3);
  77.     If   YAngle>1024 then YAngle:=YAngle-1024;
  78.     Inc (ZAngle);
  79.     If   ZAngle>1024 then ZAngle:=ZAngle-1024;
  80.     If Keypressed then Tecla:=ReadKey;
  81.   Until Tecla=#27;
  82.   FreeMem (PtrBuffer,64000);
  83.   McgaOff;
  84. END.
  85.  
  86.  
  87.