home *** CD-ROM | disk | FTP | other *** search
/ Shareware Supreme Volume 6 #1 / swsii.zip / swsii / 116 / 3DEMO.ZIP / 3DEMO2.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-19  |  19KB  |  747 lines
  1. Program demo2;
  2. Uses Graph,Crt,BGIDrv;
  3.  
  4. const
  5.      MaxPoints  = 40;
  6.      MaxLines   = 70;
  7.      pi = 3.1415926535897932385;
  8.      ScreenWidth = 1000;
  9.      HalfWidth   = screenWidth / 2;
  10.  
  11. type
  12.     Line3d  = record
  13.        FromP, ToP  : integer;
  14.     end;
  15.     screenPoints = record
  16.        sX,sY : integer;
  17.     end;
  18.     axisType = (x,y,z);
  19.     point3d = record
  20.        x, y, z     : real;
  21.     end;
  22.  
  23. const
  24.        zeroPoint : point3d = (x:0.0; y:0.0; z:0.0);
  25.  
  26. type
  27.     ctmPtr = ^ctm;
  28.     ctm = object
  29.        r11, r12, r13   : real; { change to single if numeric processor is present }
  30.        r21, r22, r23   : real;
  31.        r31, r32, r33   : real;
  32.        tx,  ty,  tz    : real;
  33.        constructor SetUnit; { set to the unit (I) matrix }
  34.        constructor Copy(var src : ctm); { construct from another }
  35.        procedure save(var dest : ctm);
  36.        procedure translate(Dx, Dy, Dz : real); { used to move .. }
  37.        procedure translateX(dx : real);
  38.        procedure translateY(dy : real);
  39.        procedure translateZ(dz : real); { translate in one axis only }
  40.        {use these routines for single axis translations, they are faster!}
  41.        procedure rotateX(t : real);
  42.        procedure rotateY(t : real);
  43.        procedure rotateZ(t : real);
  44.        procedure scale(Sx, Sy, Sz : real);
  45.        procedure scaleX(sx : real);
  46.        procedure scaleY(sy : real);
  47.        procedure scaleZ(sz : real);
  48.        procedure transform(var t: point3d; p : point3d);
  49.        procedure multiply(var c : ctm); {multiply from right self * c}
  50.        procedure Multiply_2(var a, b : ctm); { mult a*b --> ctm ? }
  51.     end;
  52.  
  53.  
  54. type
  55.     f_real = file of real;
  56.     BaseObjectPtr = ^BaseObject;
  57.     BaseObject = object
  58.        MyCtm       : Ctm;      { This CTM applied to the object gives the  }
  59.                                {  objects Position after transformations   }
  60.        Name        : String;   { Identifies the object                     }
  61.        myColor     : word;     { Main color for the object                 }
  62.        Location    : point3d;  { Central of gravity in real space          }
  63.        scrPntUpdt  : boolean;  { True if screen points updated             }
  64.        constructor open(myName : string; color : word);
  65.        destructor  CloseMe; virtual;
  66.        procedure   show; virtual;
  67.        procedure   hide; virtual;
  68.        procedure   paint; virtual; {in specified color}
  69.        procedure   updateScreenPoints; virtual; {transform object 3D -> 2D}
  70.        procedure   move(axis : axisType; by : real); virtual;
  71.        procedure   translate(dx, dy, dz : integer); virtual;
  72.                {multy dimentional move in 1 call}
  73.        procedure   scale(axis : axisType; factor : real); virtual;
  74.        procedure   allScale(sx, sy, sz : real); virtual;
  75.                {multy dimentional scale in 1 call}
  76.        procedure   rotate(axis : axisType; deg : real); virtual;
  77.        procedure   goto3dPos(x, y, z : real); virtual; {translate to absolute place}
  78.        procedure   setToOrigin; virtual;
  79.                {translate to 0,0,0, update points, and set myCtm to unit}
  80.        procedure   calcLocation; virtual; {set Location to central gravity}
  81.        procedure   deleteTransform; virtual; {set MyCtm to unit}
  82.  
  83.        function load : word; virtual; {from disk}
  84.        function save : word; virtual; {to   disk}
  85.        procedure writeMe(var elementFile : f_real); virtual; {to disk .. without opening file..}
  86.        procedure readMe(var elementFile : f_real); virtual;
  87.     end;
  88.  
  89.  
  90.     Obj3dPtr = ^Obj3d;
  91.     Obj3d = object(BaseObject)
  92.        Points      : array[1..MaxPoints] of point3d;
  93.        Lines       : array[1..MaxLines]   of Line3d;
  94.        scrPoints   : array[1..MaxPoints] of screenPoints;
  95.        NumOfLines  : integer;
  96.        NumOfPoints : integer;
  97.        ReverseRot  : Ctm;  { Saves only the reverse rotations }
  98.        unReverseRot: Ctm;  { reverse of the above}
  99.        constructor open(myName : string; ref : point3d; color : word);
  100.        destructor  CloseMe; virtual;
  101.        procedure   paint; virtual; {in specified color}
  102.        procedure   updateScreenPoints; virtual; {transform object 3D -> 2D}
  103.        procedure   calcLocation; virtual; {set Location to central gravity}
  104.        procedure   setToOrigin; virtual;
  105.        procedure writeMe(var elementFile : f_real); virtual;
  106.        procedure readMe(var elementFile : f_real); virtual;
  107.     end;
  108.  
  109. var
  110.    OutString,OutString2  : String;
  111.     MaxX, MaxY : word;          { In pixels for graphics screen }
  112.     MaxColor   : word;
  113.     GraphDriver           : integer;
  114.     GraphMode             : integer;
  115.  
  116.  
  117. var OldExitProc           : Pointer;
  118.  
  119. constructor ctm.SetUnit;
  120. begin
  121.     r11 := 1; r12 := 0; r13 := 0;
  122.     r21 := 0; r22 := 1; r23 := 0;
  123.     r31 := 0; r32 := 0; r33 := 1;
  124.     Tx  := 0; Ty  := 0; Tz  := 0;
  125. end;
  126.  
  127. constructor ctm.copy;
  128. begin
  129.     r11 := Src.r11;
  130.     r12 := Src.r12;
  131.     r13 := Src.r13;
  132.     r21 := Src.r21;
  133.     r22 := Src.r22;
  134.     r23 := Src.r23;
  135.     r31 := Src.r31;
  136.     r32 := Src.r32;
  137.     r33 := Src.r33;
  138.     tx := Src.tx;
  139.     ty := Src.ty;
  140.     tz := Src.tz;
  141. end;
  142.  
  143.  
  144. procedure ctm.save;
  145. begin
  146.     dest := self;
  147. end;
  148.  
  149.  
  150. procedure ctm.translate;
  151. begin
  152.     Tx := Tx + Dx;
  153.     Ty := Ty + Dy;
  154.     Tz := Tz + Dz;
  155. end;
  156.  
  157.  
  158. procedure ctm.translateX;
  159. begin
  160.        tx := tx+dx;
  161. end;
  162.  
  163.  
  164. procedure ctm.translateY;
  165. begin
  166.     ty := ty+dy;
  167. end;
  168.  
  169.  
  170. procedure ctm.translateZ;
  171. begin
  172.        tz := tz+dz;
  173. end;
  174.  
  175.  
  176. procedure ctm.scale;
  177. begin
  178.     r11 := r11*Sx;     r12 := r12*Sy;      r13 := r13*Sz;
  179.     r21 := r21*Sx;     r22 := r22*Sy;      r23 := r23*Sz;
  180.     r31 := r31*Sx;     r32 := r32*Sy;      r33 := r33*Sz;
  181.     tx :=  tx*Sx;      ty  :=  ty*Sy;      tz  :=  tz*Sz
  182. end;
  183.  
  184.  
  185. procedure ctm.scaleZ;
  186. begin
  187.     r13 := r13*Sz;
  188.     r23 := r23*Sz;
  189.     r33 := r33*Sz;
  190.     tz :=  tz*Sz;
  191. end;
  192.  
  193.  
  194. procedure ctm.scaleY;
  195. begin
  196.        r12 := r12*Sy;
  197.        r22 := r22*Sy;
  198.        r32 := r32*Sy;
  199.        ty  :=  ty*Sy;
  200. end;
  201.  
  202.  
  203. procedure ctm.scaleX;
  204. begin
  205.     r11 := r11*Sx;
  206.     r21 := r21*Sx;
  207.     r31 := r31*Sx;
  208.     tx :=  tx*Sx;
  209. end;
  210.  
  211.  
  212. procedure ctm.rotateZ;
  213. var
  214.     cost, sint : real;
  215.     tmp        : real;
  216. begin
  217.     cost := cos((pi/180) * t);
  218.     sint := sin((pi/180) * t);
  219.     tmp := r11*cost - r12*sint;
  220.     r12 := r11*sint + r12*cost;
  221.     r11 := tmp;
  222.     tmp := r21*cost - r22*sint;
  223.     r22 := r21*sint + r22*cost;
  224.     r21 := tmp;
  225.     tmp := r31*cost - r32*sint;
  226.     r32 := r31*sint + r32*cost;
  227.     r31 := tmp;
  228.     tmp := tx *cost - ty *sint;
  229.     ty := tx *sint + ty *cost;
  230.     tx := tmp;
  231. end;
  232.  
  233.  
  234. procedure ctm.rotateX;
  235. var
  236.     cost, sint : real;
  237.     tmp        : real;
  238. begin
  239.     cost := cos((pi/180) * t);
  240.     sint := sin((pi/180) * t);
  241.     tmp := r12*cost - r13*sint;
  242.     r13 := r12*sint + r13*cost;
  243.     r12 := tmp;
  244.     tmp := r22*cost - r23*sint;
  245.     r23 := r22*sint + r23*cost;
  246.     r22 := tmp;
  247.     tmp := r32*cost - r33*sint;
  248.     r33 := r32*sint + r33*cost;
  249.     r32 := tmp;
  250.     tmp := ty *cost - tz *sint;
  251.     tz := ty *sint + tz *cost;
  252.     ty := tmp;
  253. end;
  254.  
  255.  
  256. procedure ctm.rotateY;
  257. var
  258.     cost, sint : real;
  259.     tmp        : real;
  260. begin
  261.     cost := cos((pi/180) * t);
  262.     sint := sin((pi/180) * t);
  263.     tmp := r11*cost + r13*sint;
  264.     r13 := r13*cost - r11*sint;
  265.     r11 := tmp;
  266.     tmp := r21*cost + r23*sint;
  267.     r23 := r23*cost - r21*sint;
  268.     r21 := tmp;
  269.     tmp := r31*cost + r33*sint;
  270.     r33 := r33*cost - r31*sint;
  271.     r31 := tmp;
  272.     tmp := tx *cost + tz *sint;
  273.     tz := tz *cost - tx *sint;
  274.     tx := tmp;
  275. end;
  276.  
  277.  
  278. procedure ctm.transform;
  279. begin
  280.     t.x := p.x*r11 + p.y*r21 + p.z*r31 + tx;
  281.     t.y := p.x*r12 + p.y*r22 + p.z*r32 + ty;
  282.     t.z := p.x*r13 + p.y*r23 + p.z*r33 + tz;
  283. end;
  284.  
  285.  
  286. procedure ctm.multiply;
  287. var
  288.     t : ctm;
  289. begin
  290.        t.r11 := r11*c.r11+r12*c.r21+r13*c.r31;
  291.        t.r21 := r21*c.r11+r22*c.r21+r23*c.r31;
  292.        t.r31 := r31*c.r11+r32*c.r21+r33*c.r31;
  293.        t.tx  := tx *c.r11+ty *c.r21+tz *c.r31+c.tx;
  294.        t.r12 := r11*c.r12+r12*c.r22+r13*c.r32;
  295.        t.r22 := r21*c.r12+r22*c.r22+r23*c.r32;
  296.        t.r32 := r31*c.r12+r32*c.r22+r33*c.r32;
  297.        t.ty  := tx *c.r12+ty *c.r22+tz *c.r32+c.ty;
  298.        t.r13 := r11*c.r13+r12*c.r23+r13*c.r33;
  299.        t.r23 := r21*c.r13+r22*c.r23+r23*c.r33;
  300.        t.r33 := r31*c.r13+r32*c.r23+r33*c.r33;
  301.        t.tz  := tx *c.r13+ty *c.r23+tz *c.r33+c.tz;
  302.        copy(t);
  303. end;
  304.  
  305.  
  306. procedure ctm.multiply_2;
  307. begin
  308.     r11 := a.r11*b.r11+a.r12*b.r21+a.r13*b.r31;
  309.     r21 := a.r21*b.r11+a.r22*b.r21+a.r23*b.r31;
  310.     r31 := a.r31*b.r11+a.r32*b.r21+a.r33*b.r31;
  311.     tx := a.tx *b.r11+a.ty *b.r21+a.tz *b.r31+b.tx;
  312.     r12 := a.r11*b.r12+a.r12*b.r22+a.r13*b.r32;
  313.     r22 := a.r21*b.r12+a.r22*b.r22+a.r23*b.r32;
  314.     r32 := a.r31*b.r12+a.r32*b.r22+a.r33*b.r32;
  315.     ty := a.tx *b.r12+a.ty *b.r22+a.tz *b.r32+b.ty;
  316.     r13 := a.r11*b.r13+a.r12*b.r23+a.r13*b.r33;
  317.     r23 := a.r21*b.r13+a.r22*b.r23+a.r23*b.r33;
  318.     r33 := a.r31*b.r13+a.r32*b.r23+a.r33*b.r33;
  319.     tz := a.tx *b.r13+a.ty *b.r23+a.tz *b.r33+b.tz;
  320. end;
  321.  
  322.  
  323. procedure MyExitProc; far;
  324. Begin
  325.   ExitProc := OldExitProc; { Restore exit procedure address }
  326.   CloseGraph;              { Shut down the graphics system }
  327. End;
  328.  
  329.  
  330. Procedure StartGraph;
  331. var
  332.   ErrorCode : integer;
  333. Begin
  334.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  335.   RegisterBGIDriver(@EGAVGADriver);
  336.   OldExitProc := ExitProc;                { save previous exit proc }
  337.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  338.   GraphDriver := VGA;                  { use autodetection }
  339.   GraphMode   := 2;
  340.   InitGraph(GraphDriver,GraphMode,'');  { activate graphics }
  341.   ErrorCode := GraphResult;               { error? }
  342.   if ErrorCode <> grOk then
  343.   Begin
  344.     Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  345.     Writeln;
  346.     Writeln('  It seems as though your computer does not support VGA');
  347.     Halt(1);
  348.   End;
  349.   MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  350.   MaxX := GetMaxX;          { Get screen resolution values }
  351.   MaxY := GetMaxY;
  352. End;
  353.  
  354.  
  355. procedure calcPoint(p3d : point3d; var psc : screenPoints);
  356. Begin with p3d, psc do
  357.   Begin
  358.     sX := Round( (x*(HalfWidth/(HalfWidth-z))) * (MaxX/ScreenWidth) ) + (MaxX DIV 2);
  359.     sY := Round( (-y*(HalfWidth/(HalfWidth-z))) * (MaxY/ScreenWidth) ) + (MaxY DIV 2);
  360.   end;
  361. End;
  362.  
  363.  
  364. constructor BaseObject.Open;
  365. begin
  366.     name      := myName;
  367.     myColor   := color;
  368.     location  := ZeroPoint;
  369.     MyCtm.SetUnit;
  370. end;
  371.  
  372.  
  373. destructor BaseObject.CloseMe;
  374. begin
  375. end;
  376.  
  377.  
  378. procedure BaseObject.move(axis : axisType; by: real);
  379. begin
  380.        case axis of
  381.                x : begin
  382.                        myCtm.translateX(by);
  383.                        location.x :=location.x+by;
  384.                    end;
  385.                y : begin
  386.                        myCtm.translateY(by);
  387.                        location.y :=location.y+by;
  388.                    end;
  389.                z : begin
  390.                        myCtm.translateZ(by);
  391.                        location.z :=location.z+by;
  392.                    end;
  393.        end; {case}
  394.        scrPntUpdt := False;
  395. end;
  396.  
  397.  
  398. procedure BaseObject.translate(dx, dy, dz : integer);
  399. begin
  400.        myCtm.translate(dx,dy,dz);
  401.        location.x :=location.x+dx;
  402.        location.y :=location.y+dy;
  403.        location.z :=location.z+dz;
  404.        scrPntUpdt := False;
  405. end;
  406.  
  407.  
  408. procedure BaseObject.show;
  409. begin
  410.     setColor(myColor);
  411.     paint;
  412. end;
  413.  
  414.  
  415. procedure BaseObject.hide;
  416. begin
  417.     setColor(0); {backGround}
  418.     paint;      {at this color}
  419. end;
  420.  
  421.  
  422. procedure BaseObject.Paint;
  423. begin
  424.     if (not(scrPntUpdt)) then
  425.        updateScreenPoints;
  426. end;
  427.  
  428.  
  429. procedure BaseObject.UpdateScreenPoints;
  430. begin
  431.     scrPntUpdt := True;
  432. end;
  433.  
  434.  
  435. procedure BaseObject.scale(axis : axisType; factor : real);
  436. begin
  437.        myCtm.translate(-location.x,-location.y,-location.z);
  438.        case axis of
  439.                x : myCtm.scaleX(factor);
  440.                y : myCtm.scaleY(factor);
  441.                z : myCtm.scaleZ(factor);
  442.        end; {scale}
  443.        myCtm.translate(location.x,location.y,location.z);
  444.        scrPntUpdt := False;
  445. end; {baseObject.scale}
  446.  
  447.  
  448. procedure BaseObject.allScale(sx,sy,sz : real);
  449. begin
  450.     myCtm.translate(-location.x, -location.y, -location.z);
  451.     myCtm.scale(sx,sy,sz);
  452.     myCtm.translate(location.x, location.y, location.z);
  453.     scrPntUpdt := False;
  454. end;
  455.  
  456.  
  457. procedure BaseObject.goto3dPos;
  458. begin
  459.        translate(round(x - location.x), round(y - location.y)
  460.                        , round(z - location.z));
  461. end;
  462.  
  463.  
  464. procedure BaseObject.setToOrigin;
  465. begin
  466.     goto3dPos(0, 0, 0);
  467.     myCtm.setUnit;
  468.     location := zeroPoint;
  469. end;
  470.  
  471.  
  472. procedure BaseObject.CalcLocation;
  473. begin
  474.     location := zeroPoint;
  475. end;
  476.  
  477.  
  478. procedure BaseObject.deleteTransform;
  479. begin
  480.     myCtm.setUnit;
  481.     scrPntUpdt := false;
  482. end;
  483.  
  484.  
  485. procedure BaseObject.rotate;
  486. begin
  487.        myCtm.translate(-location.x,-location.y,-location.z);
  488.        case axis of
  489.                x :     myCtm.rotateX(deg);
  490.                y :     myCtm.rotateY(deg);
  491.                z :     myCtm.rotateZ(deg);
  492.        end; {case}
  493.        myCtm.translate(location.x,location.y,location.z);
  494.  
  495.        scrPntUpdt := False;
  496. end;
  497.  
  498.  
  499. function baseObject.load;
  500. var
  501.     elementFile : f_real;
  502.     errC       : word;
  503. begin
  504.     {$i-} {supposed to be so, just making sure}
  505.     assign(elementFile,name);
  506.     reset(elementFile); {o.k. open it}
  507.     errC := ioResult;
  508.     load := errC;
  509.     if (errC = 0) then begin
  510.        readMe(elementFile);
  511.        errC := ioResult;
  512.        load := errC;
  513.        close(elementFile);
  514.        calcLocation;
  515.        scrPntUpdt := false;
  516.     end; {if}
  517. end;
  518.  
  519.  
  520. function baseObject.save;
  521. var
  522.     elementFile : f_real;
  523.     errC       : word;
  524. begin
  525.     {$i-} {supposed to be so, just making sure}
  526.     assign(elementFile,name);
  527.     rewrite(elementFile); {o.k. open it}
  528.     errC := ioResult;
  529.     save := errC;
  530.     if (errC = 0) then begin
  531.        writeMe(elementFile);
  532.        errC := ioResult; save := errC;
  533.        close(elementFile);
  534.     end; {if}
  535. end;
  536.  
  537.  
  538. procedure baseObject.writeMe;
  539. begin
  540.    {override by descendents }
  541. end;
  542.  
  543.  
  544. procedure baseObject.readMe;
  545. begin
  546.    {override by descendents }
  547. end;
  548.  
  549.  
  550. constructor Obj3d.open;
  551. begin
  552.     BaseObject.Open(myName, color);
  553.     scrPntUpdt := False; {not calculated yet}
  554.     numOfLines := 0;
  555.     numOfPoints := 0;
  556.     myCtm.setUnit; {initialize to unit matrix}
  557.     reverseRot.setUnit;
  558.     unReverseRot.setUnit;
  559. end;
  560.  
  561.  
  562. destructor Obj3d.CloseMe;
  563. begin
  564. end;
  565.  
  566.  
  567. procedure Obj3d.updateScreenPoints;
  568. var i : integer;
  569.     p : point3d;
  570. begin
  571.     for i := 1 to numOfPoints do begin
  572.        myCtm.transform(p,points[i]); {transform by ctm}
  573.        calcPoint(p, scrPoints[i]);
  574.     end; {for}
  575.     scrPntUpdt := True; {make sure for next time..}
  576.            {make all points ready}
  577. end;
  578.  
  579.  
  580. procedure Obj3d.paint;
  581. var
  582.     i : integer;
  583. begin
  584.     if ((numOfPoints = 0) or (numOfLines = 0)) then exit;
  585.     if (not(scrPntUpdt)) then
  586.        updateScreenPoints;
  587.     for i := 1 to numOfLines do
  588.        line(   scrPoints[lines[i].fromP].sX,
  589.                scrPoints[lines[i].fromP].sY,
  590.                scrPoints[lines[i].toP].sX,
  591.                scrPoints[lines[i].toP].sY  );
  592.     {it should be noted that calcPoint has to convert points to integers}
  593. end;
  594.  
  595.  
  596. procedure obj3d.readMe;
  597. var
  598.     tmp1,tmp2  : real;
  599.     i,j        : byte;
  600. begin
  601.        read(elementFile, tmp1);
  602.        numOfPoints := trunc(tmp1);
  603.        for j := 1 to numOfPoints do begin
  604.            read(elementFile, points[j].x);
  605.            read(elementFile, points[j].y);
  606.            read(elementFile, points[j].z);
  607.        end; {for}
  608.        read(elementFile, tmp1);
  609.        numOfLines := trunc(tmp1);
  610.        for j := 1 to numOfLines do begin
  611.            read(elementFile, tmp1, tmp2);
  612.            lines[j].fromP := trunc(tmp1);
  613.            lines[j].toP   := trunc(tmp2);
  614.        end; {for}
  615. end;
  616.  
  617.  
  618. procedure obj3d.writeMe;
  619. var
  620.     tmp1,tmp2  : real;
  621.     i,j        : byte;
  622. begin
  623.        tmp1 := numOfPoints;
  624.        write(elementFile, tmp1);
  625.        for j := 1 to numOfPoints do begin
  626.            write(elementFile, points[j].x);
  627.            write(elementFile, points[j].y);
  628.            write(elementFile, points[j].z);
  629.        end; {for}
  630.        tmp1 := numOfLines;
  631.        write(elementFile, tmp1);
  632.        for j := 1 to numOfLines do begin
  633.            tmp1 := lines[j].fromP;
  634.            tmp2 := lines[j].toP;
  635.            write(elementFile, tmp1, tmp2);
  636.        end;
  637. end;
  638.  
  639.  
  640. procedure obj3d.calcLocation;
  641. var
  642.        ce : point3d;
  643.        p  : point3d;
  644.        i  : integer;
  645. begin
  646.        ce := zeroPoint; { (0, 0, 0) -> ce }
  647.        for i := 1 to numOfPoints do begin
  648.                myCtm.transform(p, points[i]);
  649.                ce.x := ce.x + p.x;
  650.                ce.y := ce.y + p.y;
  651.                ce.z := ce.z + p.z;
  652.        end; {for}
  653.        location.x := ce.x / numOfPoints;
  654.        location.y := ce.y / numOfPoints;
  655.        location.z := ce.z / numOfPoints;
  656. end;
  657.  
  658.  
  659. procedure Obj3d.setToOrigin;
  660. var
  661.        i : integer;
  662.        p : point3d;
  663. begin
  664.     goto3dPos(0, 0, 0);
  665.     for i := 1 to numOfPoints do begin
  666.            myCtm.transform(p, points[i]);
  667.            points[i] := p;
  668.     end; {for}
  669.     scrPntUpdt := False; (** Instead of that THING above **)
  670.     myCtm.setUnit;
  671.     location := zeroPoint;
  672. end;
  673.  
  674.  
  675. var
  676.  i,Dlay,code,
  677.  element : integer;
  678.  ee : word;
  679.  obj : array [ 1 .. 9 ] of baseObjectPtr;
  680.  ch : char;
  681.  V0 ,V1 ,V2 ,V3 ,V4 ,V5 ,V6 ,V7 ,V8 ,V9 : real;
  682.  I0 ,I1 ,I2 ,I3 ,I4 ,I5 ,I6 ,I7 ,I8 ,I9 : integer;
  683.  
  684.  
  685. procedure error(i : byte; j : word);
  686. var
  687.  errStr : string[20];
  688.  a :char;
  689. begin
  690.  restoreCrtMode;
  691.  case i of
  692.   1 : errStr := 'I/O error #'
  693.   else errStr := 'General error #'
  694.  end; { case }
  695.  writeln;
  696.  write(errStr);
  697.  if (j <> 0) then begin
  698.   write(j);
  699.   if j=2 then Writeln('>  Files Not Found (OBJ1.3DD and OBJ2.3DD)');
  700.   end
  701.  else
  702.   writeln;
  703.  closeGraph;
  704.  halt(1)
  705. end;
  706.  
  707.  
  708. Begin
  709. OutString:='OBJ1.3DD';
  710. OutString2:='OBJ2.3DD';
  711. StartGraph;SetColor(White);
  712. OutTextXY(10,10,'Press a key to stop...');
  713.  
  714.  Obj[1] := new(obj3dPtr, open(OutString, zeroPoint, maxColor));
  715.  Obj[2] := new(obj3dPtr, open(OutString2, zeroPoint, maxColor));
  716.  
  717.  ee := obj[1]^.load;
  718.  ee := obj[2]^.load;
  719.  if (ee <> 0) then
  720.   error(1, ee);
  721.         Obj[1]^.myctm.SetUnit;
  722.         Obj[2]^.myctm.SetUnit;
  723.         Obj[1]^.AllScale(1.5,1.7,1.5);
  724.         Obj[2]^.AllScale(1.0,1.5,1.0);
  725.         Obj[1]^.goto3DPos(0,0,0);
  726.         Obj[2]^.goto3dpos(0,0,0);
  727.  
  728.   repeat
  729.           obj[1]^.myctm.rotateX(1);
  730.           obj[2]^.myctm.rotateY(1);
  731.  
  732.           obj[1]^.ScrPntUpdt:=True;
  733.           obj[2]^.ScrPntUpdt:=True;
  734.  
  735.           obj[1]^.Hide;
  736.           obj[2]^.Hide;
  737.  
  738.           obj[1]^.ScrPntUpdt:=False;
  739.           obj[2]^.ScrPntUpdt:=False;
  740.  
  741.           obj[1]^.show;
  742.           obj[2]^.show;
  743.  
  744.           Delay(8);
  745.   until keypressed;
  746. closeGraph;
  747. end.