home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / gr3d / ts_gr3d.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-23  |  9.2 KB  |  335 lines
  1. (***********************************************************)
  2. (*                                                         *)
  3. (*   Program: TS_GR3d.PAS                                  *)
  4. (*                                                         *)
  5. (*   Specification: Testing program for Gr3d units         *)
  6. (*                                                         *)
  7. (*   Operation Date: 8/01/93                               *)
  8. (*                                                         *)
  9. (*   Description:                                          *)
  10. (*                                                         *)
  11. (*     Uses Gr3d_pt, Gr3d_obj, Gr3d_lst. This is a testing *)
  12. (*   program, I wrote it to create and test simple 3d      *)
  13. (*   objects. Gr3d???? units are implemented using matrix  *)
  14. (*   (see MM_mem for detailed implementation.              *)
  15. (*                                                         *)
  16. (*                                                         *)
  17. (*   Feedback:                                             *)
  18. (*      GEnie: M.LEI1                                      *)
  19. (*      Compuserve: 72002,157 [LEI MING]                   *)
  20. (*                                                         *)
  21. (***********************************************************)
  22. {$N+,E+,F+}  { enable numeric coprocesser, enable far call }
  23.  
  24. uses
  25.   Crt, Graph, Mm_Mem, VGA256, RateTime, Gr3d_pt, Gr3d_lst, Gr3d_obj;
  26.  
  27. const
  28.  
  29.   (* controls VGA color intensity, sateration etc. *)
  30.  
  31.   NH : Integer = 16;
  32.   NI : Integer = 5;
  33.   NS : Integer = 3;
  34.  
  35.   (* true if using VGA 256 colors *)
  36.  
  37.   UseVGA256 : Boolean = true;
  38.  
  39. type
  40.  
  41.   (* map points on a array for DrawPoly *)
  42.  
  43.   PScrnType = ^TScrnType;
  44.   TScrnType = array[1..100] of PointType;
  45.   TPlanePtrType = set of byte;
  46.  
  47.   { some simple object types }
  48.  
  49.   PBox = ^TBox;
  50.   TBox = object(TPointGroup)
  51.     SideX, SideY, SideZ: integer;
  52.     C: integer;
  53.     P: integer;
  54.     constructor Init(InitX, InitY, InitZ: integer;
  55.                      InitSideX, InitSideY, InitSideZ: integer;
  56.                      InitP, InitC: integer);
  57.     procedure Draw; virtual;
  58.   end;
  59.  
  60.   PPlane = ^TPlane;
  61.   TPlane = object(TPointGroup)
  62.     SideX, SideY: integer;
  63.     C: integer;
  64.     P: integer;
  65.     constructor Init(InitX, InitY, InitZ: integer;
  66.                      InitSideX, InitSideY: integer;
  67.                      InitP, InitC: integer);
  68.     procedure Draw; virtual;
  69.   end;
  70.  
  71. {------------------------------}
  72. { Supporting procedures }
  73.  
  74. procedure DrawPlane(Condition: boolean; P1, P2, P3, P4: PointType; C: integer);
  75. var
  76.     S: Array[1..5] of PointType;
  77. begin
  78.     if condition then
  79.   begin
  80.         S[1] := P1;
  81.       S[2] := P2;
  82.       S[3] := P3;
  83.       S[4] := P4;
  84.       S[5] := P1;
  85.       SetColor(C);
  86.     SetFillStyle(SolidFill, C);
  87.       FillPoly(5, S);
  88.   end;
  89. end;
  90.  
  91. function UseColor(S, P, C: Integer): integer;
  92. begin
  93.     if UseVGA256 then    UseColor := VGAColor(S,P-1,C-1)
  94.                else UseColor := GetColor;
  95. end;
  96.  
  97. {------------------------------}
  98. { Box methords }
  99. constructor TBox.Init(InitX, InitY, InitZ: integer;
  100.                       InitSideX, InitSideY, InitSideZ: integer;
  101.                       InitP, InitC: integer);
  102. begin
  103.  
  104.   TPointGroup.Init(InitX, InitY, InitZ);  { init object }
  105.   SideX := InitSideX;                     { initX, Y and Z is an inital point }
  106.   SideY := InitSideY;
  107.   SideZ := InitSideZ;
  108.   P := InitP;
  109.   C := InitC;
  110.  
  111.   InsertPoint(InitX+SideX, InitY, InitZ);  { insert other points }
  112.   InsertPoint(InitX+SideX, InitY, InitZ+SideZ);
  113.   InsertPoint(InitX, InitY, InitZ+SideZ);
  114.   InsertPoint(InitX, InitY+SideY, InitZ+SideZ);
  115.   InsertPoint(InitX+SideX, InitY+SideY, InitZ+SideZ);
  116.   InsertPoint(InitX+SideX, InitY+SideY, InitZ);
  117.   InsertPoint(InitX, InitY+SideY, InitZ);
  118.  
  119. end;
  120.  
  121. procedure TBox.Draw;   { draw object }
  122.                        { other methords are inhereted from TPointGroup }
  123. var
  124.   SM: PMatrix;
  125.   S: PScrnType;
  126. begin
  127.   MConvertPoints(M, SM); { convert 3d points to a 2xn matrix }
  128.   S := Pointer(SM^.Buf); { map points on array }
  129.  
  130.   (* Draw planes
  131.   (* DrawPlane(GetX(1)+SideX<0, S^[5],S^[6],S^[7],S^[8], UseColor(0,P,C));  do not show back plane *)
  132.  
  133.   DrawPlane(GetX(1)>0,    S^[1],S^[4],S^[5],S^[8], UseColor(1,P,C));
  134.   DrawPlane(GetX(1)+SideX<0, S^[2],S^[7],S^[6],S^[3], UseColor(1,P,C));
  135.   DrawPlane(GetZ(1)>0, S^[1],S^[2],S^[7],S^[8], UseColor(0,P,C));
  136.   DrawPlane(GetZ(1)+SideZ<0,        S^[4],S^[5],S^[6],S^[3], UseColor(NI-2,P,C));
  137.   DrawPlane(GetY(1)>0,        S^[1],S^[2],S^[3],S^[4], UseColor(NI-3,P,C));
  138.  
  139.   DelMatrix(SM); { delete matrix }
  140. end;
  141.  
  142. {------------------------------}
  143. { Plane methords }
  144.  
  145. constructor TPlane.Init(InitX, InitY, InitZ: integer;
  146.                         InitSideX, InitSideY: integer;
  147.                         InitP, InitC: integer);
  148. begin
  149.  
  150.   TPointGroup.Init(InitX, InitY, InitZ);  { init object }
  151.   SideX := InitSideX;                     { initX, Y and Z is an inital point }
  152.   SideY := InitSideY;
  153.   P := InitP;
  154.   C := InitC;
  155.  
  156.   InsertPoint(InitX+SideX, InitY, InitZ);  { insert other points }
  157.   InsertPoint(InitX+SideX, InitY+SideY, InitZ);
  158.   InsertPoint(InitX, InitY+SideY, InitZ);
  159.  
  160. end;
  161.  
  162. procedure TPlane.Draw;   { draw object }
  163.                          { other methords are inhereted from TPointGroup }
  164. var
  165.   SM: PMatrix;
  166.   S: PScrnType;
  167. begin
  168.   MConvertPoints(M, SM); { convert 3d points to a 2xn matrix }
  169.   S := Pointer(SM^.Buf); { map points on array }
  170.  
  171.   (* Draw plane *)
  172.  
  173.   if GetZ(1)<0 then
  174.     DrawPlane(true, S^[1],S^[2],S^[3],S^[4], UseColor(NI-1,P,C))
  175.   else
  176.     DrawPlane(true, S^[1],S^[2],S^[3],S^[4], UseColor(0,P,C));
  177.  
  178.   DelMatrix(SM); { delete matrix }
  179. end;
  180.  
  181.  
  182. {------------------------------}
  183. { additional procedures }
  184.  
  185. procedure HeapStatus(Msg: string);
  186. var
  187.   Temp: string;
  188. begin
  189.   Str(MemAvail:6, Temp);
  190.   Writeln(Msg+Temp);
  191. end;
  192.  
  193. procedure StartGraph;
  194. var
  195.   grDriver: integer;
  196.   grMode: integer;
  197. begin
  198.  
  199.   DefaultColor := 0;   { default background color: black }
  200.   VGA256Init;          { init VGA }
  201.   grDriver := Detect;
  202.   InitGraph(grDriver,grMode,'\tp\bgi');
  203.   SetColor(DefaultColor);
  204.   BackColor := 6;      { set background color to 6}
  205.  
  206.   GraphMidx := (GetMaxX div 2); { set center point of screen }
  207.   GraphMidy := (GetMaxy div 2);
  208.  
  209.   VidPageSize := 60*1024; { set page size to 60 k }
  210.   VidPageSize := 0;
  211.     if VGA256Inited then
  212.   begin
  213.       VGAConvertColor(NI, NS, NH);
  214.     UseVGA256 := true;
  215.   end;
  216. end;
  217.  
  218. procedure Waitforkey; { continue when a key is pressed }
  219. var
  220.   ch: char;
  221. begin
  222.   while not(keypressed) do;
  223.   ch := readkey;
  224. end;
  225.  
  226. {----------- main }
  227. var
  228.   Vtime: float;  { returned from TestRate routine }
  229.  
  230.   MyView: View;  { declare 4 views }
  231.   MyView2: View;
  232.   MyView3: View;
  233.   MyView4: View;
  234.  
  235. procedure TestIt; { Draw all views }
  236. var
  237.   DeltaX, DeltaY, DeltaZ: integer;
  238. begin
  239.  
  240.   (* four views *)
  241.  
  242.   while MyView.GetDelta(DeltaX, DeltaY, DeltaZ) do
  243.   begin
  244.     MyView.Select;
  245.       MyView.Step(DeltaX,DeltaY,DeltaZ);
  246.     MyView2.Select;
  247.       MyView2.Step(-DeltaX,-DeltaY,-DeltaZ);
  248.     MyView3.Select;
  249.       MyView3.Step(-DeltaX,-DeltaY,-DeltaZ);
  250.     MyView4.Select;
  251.       MyView4.Step(DeltaX,DeltaY,DeltaZ);
  252.   end;
  253.  
  254. end;
  255.  
  256. procedure TestDrawRate; { test routine for TestRate }
  257. begin
  258.   MyView.Select;
  259.     MyView.Step(1,1,1);
  260.   MyView2.Select;
  261.     MyView2.Step(1,1,1);
  262.   MyView3.Select;
  263.     MyView3.Step(1,1,1);
  264.   MyView4.Select;
  265.     MyView4.Step(1,1,1);
  266. end;
  267.  
  268.  
  269. begin
  270.  
  271.   ClrScr;   {-- heap message before allocation }
  272.   HeapStatus('Before allocation:');
  273.   WaitForKey;
  274.  
  275.   {------------ Init }
  276.  
  277.     StartGraph; { init graphics }
  278.  
  279.   { MyView.Init(0,LineWide,GetMaxX, GetMaxY-LineWide-1);  select whole screen as a view }
  280.  
  281.  
  282.   { init 4 graphic viewers }
  283.  
  284.   MyView.Init(0,0, GraphMidX, GraphMidY, 100);
  285.   MyView2.Init(GraphMidX, 0, GraphMidX, GraphMidY, 101);
  286.   MyView3.Init(0, GraphMidY, GraphMidX, GraphMidY, 102);
  287.   MyView4.Init(GraphMidX, GraphMidY, GraphMidX, GraphMidY, 103);
  288.  
  289.   { set_up\draw background for each view }
  290.  
  291.   MyView.SetWindow;
  292.   MyView2.SetWindow;
  293.   MyView3.SetWindow;
  294.   MyView4.SetWindow;
  295.  
  296.   {------------ add objects into view  }
  297.   { I add same object(s) for each view }
  298.   { the only difference is the color.  }
  299.  
  300.   MyView.Add(New(PPlane, Init(0, 30, -7, 10, 10, 3, 2)),1);
  301.   MyView.Add(New(PBox, Init(0, 30, 10, 10, 10, 10, 3, 2)),1);
  302.   MyView.Add(New(PBox, Init(-10,10,-5, 3,  50,  3, 3, 3)),2);
  303.  
  304.   MyView2.Add(New(PBox, Init(0, 30, 10, 10, 10, 10, 3, 4)),1);
  305.   MyView2.Add(New(PBox, Init(-10,20,-5, 3,  50,  3, 3, 5)),2);
  306.  
  307.   MyView4.Add(New(PBox, Init(0, 30, 10, 10, 10, 10, 3, 6)),1);
  308.   MyView4.Add(New(PBox, Init(-10,20,-5, 3,  50,  3, 3, 7)),2);
  309.  
  310.   MyView3.Add(New(PBox, Init(0, 30, 10, 10, 10, 10, 3, 8)),1);
  311.   MyView3.Add(New(PBox, Init(-10,20,-5, 3,  50,  3, 3, 9)),2);
  312.  
  313.  
  314.   MyView.Select;  MyView.Show;   {-- Show all views}
  315.   MyView2.Select; MyView2.Show;
  316.   MyView3.Select; MyView3.Show;
  317.   MyView4.Select; MyView4.Show;
  318.  
  319.   Vtime := TestRate(TestDrawRate, 1); {-- test rate }
  320.  
  321.   (*  TestViews; {-- test all views } *)
  322.  
  323.   MyView.Done;      {-- Deallocate all views }
  324.   MyView2.Done;
  325.   MyView3.Done;
  326.   MyView4.Done;
  327.  
  328.   CloseGraph;       {-- close graphics }
  329.  
  330.   HeapStatus('After allocation: '); {-- heap message after deallocation }
  331.  
  332.   writeln('Operations/sec = ',Vtime:8:0);
  333.   WaitForkey;
  334.  
  335. end.