1
\$\begingroup\$

In example we've wrote some code in Pascal (graph unit) which rotates 3D object in oblique frontal (dimetric) projection in all octants positioned in center of them.

The projection's type:

img1

The code 1 (native FPC):

program p7;

    uses PtcCrt, PtcGraph; // FPC crt, graph units

    type
      TArea = record
        xc, zc, yc, xd, zd, g, gl, gb, h: integer;
      end;
      TPoint3D = record
        x, y, z: real;
      end;
      TModel = record
        p: array [ 1..16 ] of TPoint3D;
        x, y, z, l, w, h: real;
      end;
      TArray2 = array [ 1..2 ] of real;

    var
      Driver, Mode, ns, th, ii: integer;
      model_1, model_2, model_a, model: TModel;
      area: TArea;
      s: string;

      // This procedure draws axes
      procedure XYZ( area_t: TArea );
      var
        i, n, nn, ah, aw, lg, o, oo: integer;
        s, s1: string;
      begin
        ah := 8; aw := 8; lg := 15; oo := 5;

        area_t.xd := area_t.xd - ( area_t.g * 2 );
        area_t.zd := area_t.zd - ( area_t.g * 2 );
        SetFillStyle( HatchFill, 19 );
        Bar(
          area_t.xc - ( area_t.xd div 2 ) + area_t.gl, area_t.zc - ( area_t.zd div 2 ),
          area_t.xc + ( area_t.xd div 2 ), area_t.zc + ( area_t.zd div 2 ) - area_t.gb
        );

        SetLineStyle( 0, 0, 1 );

        SetColor( 21 ); Line( area_t.xc - ( area_t.xd div 2 ), area_t.zc, area_t.xc, area_t.zc );
        SetColor( 17 ); Line( area_t.xc + 1, area_t.zc, area_t.xc + ( area_t.xd div 2 ), area_t.zc );

        SetColor( 21 ); Line( area_t.xc, area_t.zc, area_t.xc, area_t.zc - ( area_t.zd div 2 ) );
        SetColor( 17 ); Line( area_t.xc, area_t.zc + 1, area_t.xc, area_t.zc + ( area_t.zd div 2 ) - area_t.gb );

        SetColor( 21 ); Line( area_t.xc, area_t.zc, area_t.xc + ( area_t.zd div 2 ) - area_t.gb, area_t.zc + ( area_t.zd div 2 ) - area_t.gb ); // Y main
        SetColor( 17 ); Line( area_t.xc, area_t.zc, area_t.xc - ( area_t.zd div 2 ), area_t.zc - ( area_t.zd div 2 ) ); // Y

        SetColor( 21 );

        Line( area_t.xc - ( area_t.xd div 2 ), area_t.zc, area_t.xc - ( area_t.xd div 2 ) + ( ah ), area_t.zc - ( aw div 2 ) );
        Line( area_t.xc - ( area_t.xd div 2 ), area_t.zc, area_t.xc - ( area_t.xd div 2 ) + ( ah ), area_t.zc + ( aw div 2 ) );
        Line( area_t.xc, area_t.zc - ( area_t.zd div 2 ), area_t.xc - ( aw div 2 ), area_t.zc - ( area_t.zd div 2 ) + ( ah ) );
        Line( area_t.xc, area_t.zc - ( area_t.zd div 2 ), area_t.xc + ( aw div 2 ), area_t.zc - ( area_t.zd div 2 ) + ( ah ) );
        Line( area_t.xc + ( area_t.zd div 2 ) - area_t.gb, area_t.zc + ( area_t.zd div 2 ) - area_t.gb,
              area_t.xc + ( area_t.zd div 2 ) - area_t.gb - round( ( ( ah + ( aw / 2 ) ) / sqrt( 2 ) ) ),
              area_t.zc + ( area_t.zd div 2 ) - area_t.gb - round( sqrt( ( sqr( aw / 2 ) + sqr( ah ) ) -
                sqr( ( ( aw / 2 ) / sqrt( 2 ) ) + ( ah / sqrt( 2 ) ) ) ) ) );
        Line( area_t.xc + ( area_t.zd div 2 ) - area_t.gb, area_t.zc + ( area_t.zd div 2 ) - area_t.gb,
              area_t.xc + ( area_t.zd div 2 ) - area_t.gb - round( sqrt( ( sqr( aw / 2 ) + sqr( ah ) ) -
                sqr( ( ( aw / 2 ) / sqrt( 2 ) ) + ( ah / sqrt( 2 ) ) ) ) ),
              area_t.zc + ( area_t.zd div 2 ) - area_t.gb - round( ( ( ah + ( aw / 2 ) ) / sqrt( 2 ) ) ) );
        SetColor( 2 );

        OutTextXY( area_t.xc - ( area_t.xd div 2 ) - lg, area_t.zc - round( th / 2 ), 'X' );
        OutTextXY( area_t.xc - 3, area_t.zc - ( area_t.zd div 2 ) - lg, 'Z' );
        OutTextXY( area_t.xc + ( area_t.zd div 2 ) - area_t.gb + lg, area_t.zc + ( area_t.zd div 2 ) - area_t.gb + lg, 'Y' );
      end;

      // This procedure calls XYZ() with center variables
      procedure XYZCenter( area_t: TArea );
      begin
        area_t.xc := GetMaxX div 2 + 1;
        area_t.zc := GetMaxY div 2 + 1;
        area_t.xd := GetMaxX + 1;
        area_t.zd := GetMaxY + 1;
        XYZ( area_t );
      end;

      // This procedure draws a line in oblique frontal projection
      procedure LineXYZ( sp_t, ep_t: TPoint3D; model_t: TModel; area_t: TArea );
      var
        x1, y1, x2, y2, xs, ys, zs, xe, ye, ze: real;
      begin
        SetColor( 14 );
        xs := sp_t.x;
        ys := sp_t.y / 2;
        zs := sp_t.z;
        xe := ep_t.x;
        ye := ep_t.y / 2;
        ze := ep_t.z;

        x1 := - xs - cos( pi / 4 ) * ys;
        y1 :=   zs - sin( pi / 4 ) * ys;
        x2 := - xe - cos( pi / 4 ) * ye;
        y2 :=   ze - sin( pi / 4 ) * ye;

        Line(
          round( area_t.xc - x1 ),
          round( area_t.zc - y1 ),
          round( area_t.xc - x2 ),
          round( area_t.zc - y2 )
        );
        SetColor( 13 );
        Str( round( sp_t.x ), s ); OutTextXY( round( area_t.xc - x1 ) + 2, round( area_t.zc - y1 ) + 10, s );
      end;

      // Let's guess that this function is supposed to send to LineXYZ function only the 1st octant's lines.
      procedure DrawFirstOctant( model_t: TModel; sp_t, ep_t: integer; area_t: TArea );
      var
        mxyz: TArray2;
        a, b, a2, b2: TPoint3D;
      begin
        a2.x := model_t.p[ sp_t ].x;
        a2.y := model_t.p[ sp_t ].y / 2;
        a2.z := model_t.p[ sp_t ].z;
        b2.x := model_t.p[ ep_t ].x;
        b2.y := model_t.p[ ep_t ].y / 2;
        b2.z := model_t.p[ ep_t ].z;


        a := a2;
        b := b2;

        LineXYZ( a, b, model_t, area_t );
      end;

      // This procedure draws each line from point3d to point3d
      procedure DrawModel( model_t: TModel; area_t: TArea );
      begin
        DrawFirstOctant( model_t, 1, 2, area_t );
        DrawFirstOctant( model_t, 2, 3, area_t );
        DrawFirstOctant( model_t, 3, 4, area_t );
        DrawFirstOctant( model_t, 4, 1, area_t );
        DrawFirstOctant( model_t, 5, 6, area_t );
        DrawFirstOctant( model_t, 6, 7, area_t );
        DrawFirstOctant( model_t, 7, 8, area_t );
        DrawFirstOctant( model_t, 8, 5, area_t );
        DrawFirstOctant( model_t, 1, 5, area_t );
        DrawFirstOctant( model_t, 2, 6, area_t );
        DrawFirstOctant( model_t, 3, 7, area_t );
        DrawFirstOctant( model_t, 4, 8, area_t );
        DrawFirstOctant( model_t, 9, 10, area_t );
        DrawFirstOctant( model_t, 10, 11, area_t );
        DrawFirstOctant( model_t, 11, 12, area_t );
        DrawFirstOctant( model_t, 12, 9, area_t );
        DrawFirstOctant( model_t, 13, 14, area_t );
        DrawFirstOctant( model_t, 14, 15, area_t );
        DrawFirstOctant( model_t, 15, 16, area_t );
        DrawFirstOctant( model_t, 16, 13, area_t );
        DrawFirstOctant( model_t, 9, 13, area_t );
        DrawFirstOctant( model_t, 10, 14, area_t );
        DrawFirstOctant( model_t, 11, 15, area_t );
        DrawFirstOctant( model_t, 12, 16, area_t );
      end;

      // This function rotates an object around X axis
      function RotateX( model_t: TModel; angle: real; cs, ce: integer ): TModel;
      var
        y, z: real;
        i: integer;
      begin
        angle := angle * pi / 180;
        for i := cs to ce do
        begin
          y := model_t.p[ i ].y;
          z := model_t.p[ i ].z;
          model_t.p[ i ].y := y * cos( angle ) - z * sin( angle );
          model_t.p[ i ].z := z * cos( angle ) + y * sin( angle );
        end;
        RotateX := model_t;
      end;

      // This function rotates an object around Y axis
      function RotateY( model_t: TModel; angle: real; cs, ce: integer ): TModel;
      var
        x, z: real;
        i: integer;
      begin
        angle := angle * pi / 180;
        for i := cs to ce do
        begin
          x := model_t.p[ i ].x;
          z := model_t.p[ i ].z;
          model_t.p[ i ].x := x * cos( angle ) - z * sin( angle );
          model_t.p[ i ].z := z * cos( angle ) + x * sin( angle );
        end;
        RotateY := model_t;
      end;

      // This function rotates an object around Z axis
      function RotateZ( model_t: TModel; angle: real; cs, ce: integer ): TModel;
      var
        x, y: real;
        i: integer;
      begin
        angle := angle * pi / 180;
        for i := cs to ce do
        begin
          x := model_t.p[ i ].x + model_t.x;
          y := model_t.p[ i ].y + model_t.y;
          model_t.p[ i ].x := -model_t.x + x * cos( angle ) - y * sin( angle );
          model_t.p[ i ].y := -model_t.y + y * cos( angle ) + x * sin( angle );
        end;
        RotateZ := model_t;
      end;

      // This function rotates an object around axes
      function RotateXYZ( model_t: TModel; rx_t, ry_t, rz_t: real; cs, ce: integer ): TModel;
      begin
        model_t := RotateX( model_t, rx_t, cs, ce );
        model_t := RotateY( model_t, ry_t, cs, ce );
        model_t := RotateZ( model_t, rz_t, cs, ce );
        RotateXYZ := model_t;
      end;

      // This procedure moves an object
      function MoveXYZ( model_t: TModel; x_t, y_t, z_t: real; cs, ce: integer ): TModel;
      var
        i: integer;
      begin
        for i := cs to ce do
        begin
          model_t.p[ i ].x := model_t.p[ i ].x - x_t;
          model_t.p[ i ].y := model_t.p[ i ].y + y_t;
          model_t.p[ i ].z := model_t.p[ i ].z + z_t;
        end;
        MoveXYZ := model_t;
      end;

    begin
      // Initializing
      Driver := D8bit;
      Mode := m800x600;
      InitGraph( Driver, Mode, '' );
      th := 6; // Symbol's height
      area.g := 20; // Padding
      area.h := 20; // Hatch step
      area.gl := 20; // Left padding
      area.gb := 40; // Bottom padding
      if ( GraphResult <> GrOk ) then WriteLn( '800x600x256''s not supported' ) else
      begin
        ClearDevice;
        area.xc := ( GetMaxX div 2 ) + 1; // The X axis center
        area.zc := ( GetMaxY div 2 ) + 1; // The Z axis center
        SetRGBPalette( 17, 55, 55, 55 ); // Colors
        SetRGBPalette( 18, 30, 30, 30 );
        SetRGBPalette( 19, 10, 10, 10 );
        SetRGBPalette( 20, 44, 44, 44 );
        SetRGBPalette( 21, 88, 88, 88 );

        // A characteristics of part of objects
        model_1.l := 40; model_1.w := 40; model_1.h := 80; model_1.x := 0; model_1.y := 0; model_1.z := -60;
        model_2.l := 300; model_2.w := 40; model_2.h := 40; model_2.x := 0; model_2.y := 0; model_2.z := 0;
        model_a.x := 0; model_a.y := 0; model_a.z := 0;

        // A 3D points of first part of object
        model_1.p[ 1 ].x := - model_1.l / 2; model_1.p[ 1 ].y := - model_1.w / 2; model_1.p[ 1 ].z := - model_1.h / 2;
        model_1.p[ 2 ].x := - model_1.l / 2; model_1.p[ 2 ].y :=   model_1.w / 2; model_1.p[ 2 ].z := - model_1.h / 2;
        model_1.p[ 3 ].x :=   model_1.l / 2; model_1.p[ 3 ].y :=   model_1.w / 2; model_1.p[ 3 ].z := - model_1.h / 2;
        model_1.p[ 4 ].x :=   model_1.l / 2; model_1.p[ 4 ].y := - model_1.w / 2; model_1.p[ 4 ].z := - model_1.h / 2;
        model_1.p[ 5 ].x := - model_1.l / 2; model_1.p[ 5 ].y := - model_1.w / 2; model_1.p[ 5 ].z :=   model_1.h / 2;
        model_1.p[ 6 ].x := - model_1.l / 2; model_1.p[ 6 ].y :=   model_1.w / 2; model_1.p[ 6 ].z :=   model_1.h / 2;
        model_1.p[ 7 ].x :=   model_1.l / 2; model_1.p[ 7 ].y :=   model_1.w / 2; model_1.p[ 7 ].z :=   model_1.h / 2;
        model_1.p[ 8 ].x :=   model_1.l / 2; model_1.p[ 8 ].y := - model_1.w / 2; model_1.p[ 8 ].z :=   model_1.h / 2;

        // A 3D points of second part of object
        model_1.p[  9 ].x := - model_2.l / 2; model_1.p[  9 ].y := - model_2.w / 2; model_1.p[  9 ].z := - model_2.h / 2;
        model_1.p[ 10 ].x := - model_2.l / 2; model_1.p[ 10 ].y :=   model_2.w / 2; model_1.p[ 10 ].z := - model_2.h / 2;
        model_1.p[ 11 ].x :=   model_2.l / 2; model_1.p[ 11 ].y :=   model_2.w / 2; model_1.p[ 11 ].z := - model_2.h / 2;
        model_1.p[ 12 ].x :=   model_2.l / 2; model_1.p[ 12 ].y := - model_2.w / 2; model_1.p[ 12 ].z := - model_2.h / 2;
        model_1.p[ 13 ].x := - model_2.l / 2; model_1.p[ 13 ].y := - model_2.w / 2; model_1.p[ 13 ].z :=   model_2.h / 2;
        model_1.p[ 14 ].x := - model_2.l / 2; model_1.p[ 14 ].y :=   model_2.w / 2; model_1.p[ 14 ].z :=   model_2.h / 2;
        model_1.p[ 15 ].x :=   model_2.l / 2; model_1.p[ 15 ].y :=   model_2.w / 2; model_1.p[ 15 ].z :=   model_2.h / 2;
        model_1.p[ 16 ].x :=   model_2.l / 2; model_1.p[ 16 ].y := - model_2.w / 2; model_1.p[ 16 ].z :=   model_2.h / 2;

        // Moves two parts to it start positions
        model_1 := MoveXYZ( model_1, model_1.x, model_1.y, model_1.z, 1, 8 );
        model_1 := MoveXYZ( model_1, model_2.x, model_2.y, model_2.z, 9, 16 );

        // Copies all parts to full one
        for ii := 1 to 16 do
        begin
          model_a.p[ ii ].x := model_1.p[ ii ].x;
          model_a.p[ ii ].y := model_1.p[ ii ].y;
          model_a.p[ ii ].z := model_1.p[ ii ].z;
        end;

        SetColor( 14 );
        // Draws axes
        XYZCenter( area );
        // Moves a whole ( full ) object
        model := MoveXYZ( model_a, model_a.x, model_a.y, model_a.z, 1, 16 );
        // Draws a whole moved object ( full )
        DrawModel( model_a, area );

        // Rotating cycle
        repeat Delay( 100 ) until KeyPressed; ReadKey;
        SetActivePage( 1 );
        SetVisualPage( 0 );
        repeat
          ClearDevice;
          XYZCenter( area );
          // Rotates an object
          model := RotateXYZ( model, 0, 0, 1, 1, 16 );

          // Draws rotated object
          SetColor( 14 );
          DrawModel( model, area );
          // Draws a circle at the center of axes
          SetColor( 12 );
          Circle( area.xc, area.zc, 2 ); OutTextXY( area.xc + 3, area.zc + 3, '[ 0, 0 ]' );

          delay( 1 );

          // Changes drawing page to smooth render
          if ns = 0 then
          begin
            SetActivePage( 0 );
            SetVisualPage( 1 )
          end
          else
          begin
            SetActivePage( 1 );
            SetVisualPage( 0 )
          end;
          if ns = 0 then ns := 1 else ns := 0;
          until KeyPressed; ReadKey;
        repeat Delay( 100 ) until KeyPressed;
        CloseGraph;
      end;
    end.

The result of code:

img2

Octants:

img3

Is it possible to draw an object only in first octant ( where points coordinates [x>0; y>0; z>0 ] and how ? Is it calls clipping and how I'd do this ?

I've read a lot information about this, and nothing about 3D, but 2D Cohen Sutherland Line Clipping Algorithm. Should we use it to achieve this ?

So I've tried with algorithm which @Bálint gave and I think that this one is something close. Also he wrote 2D clipping algorithm.

The @Bálint's algorithm:

A.x in our case is x1, A.y is y1, A.z is z1, B.x is x2, etc. If one of them is outside the drawing area ( outside of I octant ) (has a negative x, y or z coordinate) then get the one, that's the farthest away from the positive part of the coordinate system. If the X coordinate is the farthest, then you set it to 0 and yiu set the Y and Z coordinates to -A.x / (B.x - A.x) * (B.y - A.y) + A.y and -A.x / (B.x - A.x) * (B.z - A.z) + A.z respectively. Same with Y and Z, but you replace the Ys and Zs with the X and Z and X and Y respectively.

The formula for the endpoint is a bit different. You need to replace every x1, y1 and z1 with x2, y2 and z2 respectively and vice-versa.

Might be that I've made something wrong. Btw I've got this:

The code 2 is on hastebin.com because of stack's text limits.

The strange result of 2 code:

img4

As you see, now the part of II octant is something close to which one should be in I octant.

Best regards, V7

\$\endgroup\$
3
\$\begingroup\$

First of all, you need to check if the line intersects the octant. You have 3 cases:

  • The line is completely contained within the octant (the x, y, and z coordinates of the endpoints are positive). This is the easiest one to solve, you simply draw the line as it is.
  • One of the endpoints is outside, but one of them is inside the octant
  • Both endpoints are outside, but the line intersects it

I'm going to refer to the line interpolation formula a couple of times. It has 2 parts. Given a position on the x coordinate x the y coordinate of the point on the line at that x position is

D = (x - Ax) / (Bx - Ax)
if D is between 0 and 1, then y = D * (By - Ay) + Ay
otherwise the line doesn't have a point at that x position

Ax is the x coordinate of one of the endpoints and Bx is the x coordinate of the other. x and y can be changed to other axes.

So, first get the Ds on the x, y and z coordinates with the values x=y=z=0:

Dx = (0 - Ax) / (Bx - Ax)
Dy = (0 - Ay) / (By - Ay)
Dz = (0 - Az) / (Bz - Az)

If at least one of them is in the range [0, 1], then the line intersects the octant.

Now you'll need to get the remaining of the x, y and z coordinates with these, the complete code is

let points be a set of vectors

if Dx >= 0 and Dx <= 1, then
    y = Dx * (By - Ay) + Ay
    z = Dx * (Bz - Az) + Az
    if y >= 0 and z >= 0, then
        add (0, y, z) to points
    endif
endif

if Dy >= 0 and Dy <= 1, then
    x = Dy * (Bx - Ax) + Ax
    z = Dx * (Bz - Az) + Az
    if x >= 0 and z >= 0, then
        add (x, 0, z) to points
    endif
endif

if Dz >= 0 and Dz <= 1, then
    x = Dz * (Bx - Ax) + Ax
    y = Dz * (By - Ay) + Ay
    if x >= 0 and y >= 0, then
        add (x, y, 0) to points
    endif
endif

This will give you the lines endpoints, if the line intersects 2 axes and one of the endpoints, if it only intersect axis and one of the points is in the octant. In the latter case, you can get the other end point by using the endpoint in the octant:

if Ax >= 0 and Ay > 0= and Az >= 0, then
    add A to points
endif

if Bx >= 0 and By > 0= and Bz >= 0, then
    add B to points
endif

Now you only need to draw the line defined by the points set

\$\endgroup\$
0
\$\begingroup\$

The solution by @Bálint:

The code:

  program p7;

  uses PtcCrt, PtcGraph, math;

  type
    TArea = record
      xc, zc, yc, xd, zd, g, gl, gb, h: integer;
    end;
    TPoint3D = record
      x, y, z: real;
    end;
    TModel = record
      p: array [ 1..16 ] of TPoint3D;
      x, y, z, l, w, h: real;
    end;
    TArray2 = array [ 1..2 ] of real;

  var
    Driver, Mode, ns, th, ii: integer;
    model_1, model_2, model_a, model: TModel;
    rx, ry, rz: real;
    area: TArea;
    s: string;
    c: char;

    procedure XYZ( area_t: TArea );
    var
      i, n, nn, ah, aw, lg, o, oo: integer;
      s, s1: string;
    begin
      ah := 8; aw := 8; lg := 15; oo := 5;

      area_t.xd := area_t.xd - ( area_t.g * 2 );
      area_t.zd := area_t.zd - ( area_t.g * 2 );
      SetFillStyle( HatchFill, 19 );
      Bar(
        area_t.xc - ( area_t.xd div 2 ) + area_t.gl, area_t.zc - ( area_t.zd div 2 ),
        area_t.xc + ( area_t.xd div 2 ), area_t.zc + ( area_t.zd div 2 ) - area_t.gb
      );

      SetLineStyle( 0, 0, 1 );

      SetColor( 21 ); Line( area_t.xc - ( area_t.xd div 2 ), area_t.zc, area_t.xc, area_t.zc );
      SetColor( 17 ); Line( area_t.xc + 1, area_t.zc, area_t.xc + ( area_t.xd div 2 ), area_t.zc );

      SetColor( 21 ); Line( area_t.xc, area_t.zc, area_t.xc, area_t.zc - ( area_t.zd div 2 ) );
      SetColor( 17 ); Line( area_t.xc, area_t.zc + 1, area_t.xc, area_t.zc + ( area_t.zd div 2 ) - area_t.gb );

      SetColor( 21 ); Line( area_t.xc, area_t.zc, area_t.xc + ( area_t.zd div 2 ) - area_t.gb, area_t.zc + ( area_t.zd div 2 ) - area_t.gb );
      SetColor( 17 ); Line( area_t.xc, area_t.zc, area_t.xc - ( area_t.zd div 2 ), area_t.zc - ( area_t.zd div 2 ) );

      SetColor( 21 );

      Line( area_t.xc - ( area_t.xd div 2 ), area_t.zc, area_t.xc - ( area_t.xd div 2 ) + ( ah ), area_t.zc - ( aw div 2 ) );
      Line( area_t.xc - ( area_t.xd div 2 ), area_t.zc, area_t.xc - ( area_t.xd div 2 ) + ( ah ), area_t.zc + ( aw div 2 ) );
      Line( area_t.xc, area_t.zc - ( area_t.zd div 2 ), area_t.xc - ( aw div 2 ), area_t.zc - ( area_t.zd div 2 ) + ( ah ) );
      Line( area_t.xc, area_t.zc - ( area_t.zd div 2 ), area_t.xc + ( aw div 2 ), area_t.zc - ( area_t.zd div 2 ) + ( ah ) );
      Line( area_t.xc + ( area_t.zd div 2 ) - area_t.gb, area_t.zc + ( area_t.zd div 2 ) - area_t.gb,
            area_t.xc + ( area_t.zd div 2 ) - area_t.gb - round( ( ( ah + ( aw / 2 ) ) / sqrt( 2 ) ) ),
            area_t.zc + ( area_t.zd div 2 ) - area_t.gb - round( sqrt( ( sqr( aw / 2 ) + sqr( ah ) ) -
              sqr( ( ( aw / 2 ) / sqrt( 2 ) ) + ( ah / sqrt( 2 ) ) ) ) ) );
      Line( area_t.xc + ( area_t.zd div 2 ) - area_t.gb, area_t.zc + ( area_t.zd div 2 ) - area_t.gb,
            area_t.xc + ( area_t.zd div 2 ) - area_t.gb - round( sqrt( ( sqr( aw / 2 ) + sqr( ah ) ) -
              sqr( ( ( aw / 2 ) / sqrt( 2 ) ) + ( ah / sqrt( 2 ) ) ) ) ),
            area_t.zc + ( area_t.zd div 2 ) - area_t.gb - round( ( ( ah + ( aw / 2 ) ) / sqrt( 2 ) ) ) );
      SetColor( 2 );

      OutTextXY( area_t.xc - ( area_t.xd div 2 ) - lg, area_t.zc - round( th / 2 ), 'X' );
      OutTextXY( area_t.xc - 3, area_t.zc - ( area_t.zd div 2 ) - lg, 'Z' );
      OutTextXY( area_t.xc + ( area_t.zd div 2 ) - area_t.gb + lg, area_t.zc + ( area_t.zd div 2 ) - area_t.gb + lg, 'Y' );
    end;

    procedure XYZCenter( area_t: TArea );
    begin
      area_t.xc := GetMaxX div 2 + 1;
      area_t.zc := GetMaxY div 2 + 1;
      area_t.xd := GetMaxX + 1;
      area_t.zd := GetMaxY + 1;
      XYZ( area_t );
    end;

    procedure DrawLine( X1, Y1, X2, Y2: Integer; model_t: TModel; area_t: TArea );
    var
      HL, VL, L: Integer;
      dX, dY, X, Y, xxs, yys, zzs, xxe, yye, zze: Real;
      Count: Integer;
    BEGIN

      HL := X2 - X1;
      VL := Y2 - Y1;
      L := Abs(HL) + Abs(VL);
      dX := HL / L;
      dY := VL / L;
      X := X1;
      Y := Y1;

      FOR Count := 0 TO L DO
      BEGIN

        PutPixel(Round(X), Round(Y), GetColor);
        X := X + dX;
        Y := Y + dY
      END
    END;

    function MinXYZ( p_t: TPoint3D ): TArray2;
    var
      mxyz: TArray2;
    begin
      if ( ( p_t.x < 0 ) or ( p_t.y < 0 ) or ( p_t.z < 0 ) ) then
      begin
        if ( p_t.x < p_t.y ) then
        begin
          if ( p_t.x < p_t.z ) then
            begin
              mxyz[ 1 ] := 1;
              mxyz[ 2 ] := p_t.x;
            end else
            begin
              mxyz[ 1 ] := 3;
              mxyz[ 2 ] := p_t.z;
            end;
        end else if p_t.y < p_t.z then
        begin
          mxyz[ 1 ] := 2;
          mxyz[ 2 ] := p_t.y;
        end else
        begin
          mxyz[ 1 ] := 3;
          mxyz[ 2 ] := p_t.z;
        end;
      end else mxyz[ 1 ] := 0;
      MinXYZ := mxyz;
    end;

    procedure LineXYZ( sp_t, ep_t: TPoint3D; model_t: TModel; area_t: TArea );
    var
      x1, y1, x2, y2, xs, ys, zs, xe, ye, ze: real;
    begin
      xs := sp_t.x;
      ys := sp_t.y / 2;
      zs := sp_t.z;
      xe := ep_t.x;
      ye := ep_t.y / 2;
      ze := ep_t.z;

      x1 := - xs - cos( pi / 4 ) * ys;
      y1 :=   zs - sin( pi / 4 ) * ys;
      x2 := - xe - cos( pi / 4 ) * ye;
      y2 :=   ze - sin( pi / 4 ) * ye;

      SetColor( 14 );
      DrawLine(
        round( area_t.xc - x1 ),
        round( area_t.zc - y1 ),
        round( area_t.xc - x2 ),
        round( area_t.zc - y2 ),
        model_t, area_t
      );

      SetColor( 13 );
      Str( round( sp_t.x ), s ); OutTextXY( round( area_t.xc - x1 ), round( area_t.zc - y1 ), s );
    end;

    var
      points: array [ 0..40 ] of TPoint3D;
      indx: integer;

    procedure DrawFirstOctant( model_t: TModel; sp_t, ep_t: integer; area_t: TArea );
    var
      mxyz: TArray2;
      a, b, a2, b2: TPoint3D;
      dx, dy, dz: real;
    begin
      indx := 0;

      a2.x := model_t.p[ sp_t ].x;
      a2.y := model_t.p[ sp_t ].y;
      a2.z := model_t.p[ sp_t ].z;

      b2.x := model_t.p[ ep_t ].x;
      b2.y := model_t.p[ ep_t ].y;
      b2.z := model_t.p[ ep_t ].z;

      dx := - a2.x / ( b2.x - a2.x );
      dy := - a2.y / ( b2.y - a2.y );
      dz := - a2.z / ( b2.z - a2.z );

      if ( dx >= 0 ) and ( dx <= 1 ) then
      begin
        a.x := 0;
        a.y := dx * ( b2.y - a2.y ) + a2.y;
        a.z := dx * ( b2.z - a2.z ) + a2.z;
        if (a.y >= 0) and (a.z >= 0) then
        begin
           points[ indx ] := a;
           Inc( indx );
        end;
      end;

      if ( dy >= 0 ) and ( dy <= 1 ) then
      begin
        a.x := dy * (b2.x - a2.x) + a2.x;
        a.y := 0;
        a.z := dy * (b2.z - a2.z) + a2.z;
        if (a.x >= 0) and (a.z >= 0) then
        begin
           points[ indx ] := a;
           Inc( indx );
        end;
      end;

      if ( dz >= 0 ) and ( dz <= 1 ) then
      begin
        a.x := dz * (b2.x - a2.x) + a2.x;
        a.y := dz * (b2.y - a2.y) + a2.y;
        a.z := 0;
        if (a.x >= 0) and (a.y >= 0) then
        begin
           points[ indx ] := a;
           Inc( indx );
        end;
      end;

      if ( a2.x >= 0 ) and ( a2.y >= 0 ) and ( a2.z >= 0 ) then
      begin
        a.x := a2.x;
        a.y := a2.y;
        a.z := a2.z;
        points[ indx ] := a;
        Inc( indx );
      end;

      if ( b2.x >= 0 ) and ( b2.y >= 0 ) and ( b2.z >= 0 ) then
      begin
        b.x := b2.x;
        b.y := b2.y;
        b.z := b2.z;
        points[ indx ] := b;
        Inc( indx );
      end;

      if (indx >= 2) then LineXYZ( points[ 0 ], points[ 1 ], model_t, area_t );

    end;

    procedure DrawModel( model_t: TModel; area_t: TArea );
    begin
      DrawFirstOctant( model_t, 1, 2, area_t );
      DrawFirstOctant( model_t, 2, 3, area_t );
      DrawFirstOctant( model_t, 3, 4, area_t );
      DrawFirstOctant( model_t, 4, 1, area_t );
      DrawFirstOctant( model_t, 5, 6, area_t );
      DrawFirstOctant( model_t, 6, 7, area_t );
      DrawFirstOctant( model_t, 7, 8, area_t );
      DrawFirstOctant( model_t, 8, 5, area_t );
      DrawFirstOctant( model_t, 1, 5, area_t );
      DrawFirstOctant( model_t, 2, 6, area_t );
      DrawFirstOctant( model_t, 3, 7, area_t );
      DrawFirstOctant( model_t, 4, 8, area_t );
      DrawFirstOctant( model_t, 9, 10, area_t );
      DrawFirstOctant( model_t, 10, 11, area_t );
      DrawFirstOctant( model_t, 11, 12, area_t );
      DrawFirstOctant( model_t, 12, 9, area_t );
      DrawFirstOctant( model_t, 13, 14, area_t );
      DrawFirstOctant( model_t, 14, 15, area_t );
      DrawFirstOctant( model_t, 15, 16, area_t );
      DrawFirstOctant( model_t, 16, 13, area_t );
      DrawFirstOctant( model_t, 9, 13, area_t );
      DrawFirstOctant( model_t, 10, 14, area_t );
      DrawFirstOctant( model_t, 11, 15, area_t );
      DrawFirstOctant( model_t, 12, 16, area_t );
    end;


    function RotateX( model_t: TModel; angle: real; cs, ce: integer ): TModel;
    var
      y, z: real;
      i: integer;
    begin
      angle := angle * pi / 180;
      for i := cs to ce do
      begin
        y := model_t.p[ i ].y;
        z := model_t.p[ i ].z;
        model_t.p[ i ].y := y * cos( angle ) - z * sin( angle );
        model_t.p[ i ].z := z * cos( angle ) + y * sin( angle );
      end;
      RotateX := model_t;
    end;


    function RotateY( model_t: TModel; angle: real; cs, ce: integer ): TModel;
    var
      x, z: real;
      i: integer;
    begin
      angle := angle * pi / 180;
      for i := cs to ce do
      begin
        x := model_t.p[ i ].x;
        z := model_t.p[ i ].z;
        model_t.p[ i ].x := x * cos( angle ) - z * sin( angle );
        model_t.p[ i ].z := z * cos( angle ) + x * sin( angle );
      end;
      RotateY := model_t;
    end;


    function RotateZ( model_t: TModel; angle: real; cs, ce: integer ): TModel;
    var
      x, y: real;
      i: integer;
    begin
      angle := angle * pi / 180;
      for i := cs to ce do
      begin
        x := model_t.p[ i ].x + model_t.x;
        y := model_t.p[ i ].y + model_t.y;
        model_t.p[ i ].x := -model_t.x + x * cos( angle ) - y * sin( angle );
        model_t.p[ i ].y := -model_t.y + y * cos( angle ) + x * sin( angle );
      end;
      RotateZ := model_t;
    end;

    function RotateXYZ( model_t: TModel; rx_t, ry_t, rz_t: real; cs, ce: integer ): TModel;
    begin
      model_t := RotateX( model_t, rx_t, cs, ce );
      model_t := RotateY( model_t, ry_t, cs, ce );
      model_t := RotateZ( model_t, rz_t, cs, ce );
      RotateXYZ := model_t;
    end;

    function MoveXYZ( model_t: TModel; x_t, y_t, z_t: real; cs, ce: integer ): TModel;
    var
      i: integer;
    begin
      for i := cs to ce do
      begin
        model_t.p[ i ].x := model_t.p[ i ].x - x_t;
        model_t.p[ i ].y := model_t.p[ i ].y + y_t;
        model_t.p[ i ].z := model_t.p[ i ].z + z_t;
      end;
      MoveXYZ := model_t;
    end;

  begin
    Driver := D8bit;
    Mode := m800x600;
    InitGraph( Driver, Mode, '' );
    th := 6;
    area.g := 20;
    area.h := 20;
    area.gl := 20;
    area.gb := 40;
    if ( GraphResult <> GrOk ) then WriteLn( '800x600x256''s not supported' ) else
    begin
      ClearDevice;
      area.xc := ( GetMaxX div 2 ) + 1;
      area.zc := ( GetMaxY div 2 ) + 1;
      SetRGBPalette( 17, 55, 55, 55 );
      SetRGBPalette( 18, 30, 30, 30 );
      SetRGBPalette( 19, 10, 10, 10 );
      SetRGBPalette( 20, 44, 44, 44 );
      SetRGBPalette( 21, 88, 88, 88 );
      XYZCenter( area );

      model_1.l := 40; model_1.w := 40; model_1.h := 80; model_1.x := 0; model_1.y := 0; model_1.z := -60;

      model_2.l := 300; model_2.w := 40; model_2.h := 40; model_2.x := 0; model_2.y := 0; model_2.z := 0;

      model_a.x := 0; model_a.y := 0; model_a.z := 0;

      rx := 0; ry := 60; rz := -100;

      model_1.p[ 1 ].x := - model_1.l / 2; model_1.p[ 1 ].y := - model_1.w / 2; model_1.p[ 1 ].z := - model_1.h / 2;
      model_1.p[ 2 ].x := - model_1.l / 2; model_1.p[ 2 ].y :=   model_1.w / 2; model_1.p[ 2 ].z := - model_1.h / 2;
      model_1.p[ 3 ].x :=   model_1.l / 2; model_1.p[ 3 ].y :=   model_1.w / 2; model_1.p[ 3 ].z := - model_1.h / 2;
      model_1.p[ 4 ].x :=   model_1.l / 2; model_1.p[ 4 ].y := - model_1.w / 2; model_1.p[ 4 ].z := - model_1.h / 2;
      model_1.p[ 5 ].x := - model_1.l / 2; model_1.p[ 5 ].y := - model_1.w / 2; model_1.p[ 5 ].z :=   model_1.h / 2;
      model_1.p[ 6 ].x := - model_1.l / 2; model_1.p[ 6 ].y :=   model_1.w / 2; model_1.p[ 6 ].z :=   model_1.h / 2;
      model_1.p[ 7 ].x :=   model_1.l / 2; model_1.p[ 7 ].y :=   model_1.w / 2; model_1.p[ 7 ].z :=   model_1.h / 2;
      model_1.p[ 8 ].x :=   model_1.l / 2; model_1.p[ 8 ].y := - model_1.w / 2; model_1.p[ 8 ].z :=   model_1.h / 2;

      model_1.p[  9 ].x := - model_2.l / 2; model_1.p[  9 ].y := - model_2.w / 2; model_1.p[  9 ].z := - model_2.h / 2;
      model_1.p[ 10 ].x := - model_2.l / 2; model_1.p[ 10 ].y :=   model_2.w / 2; model_1.p[ 10 ].z := - model_2.h / 2;
      model_1.p[ 11 ].x :=   model_2.l / 2; model_1.p[ 11 ].y :=   model_2.w / 2; model_1.p[ 11 ].z := - model_2.h / 2;
      model_1.p[ 12 ].x :=   model_2.l / 2; model_1.p[ 12 ].y := - model_2.w / 2; model_1.p[ 12 ].z := - model_2.h / 2;
      model_1.p[ 13 ].x := - model_2.l / 2; model_1.p[ 13 ].y := - model_2.w / 2; model_1.p[ 13 ].z :=   model_2.h / 2;
      model_1.p[ 14 ].x := - model_2.l / 2; model_1.p[ 14 ].y :=   model_2.w / 2; model_1.p[ 14 ].z :=   model_2.h / 2;
      model_1.p[ 15 ].x :=   model_2.l / 2; model_1.p[ 15 ].y :=   model_2.w / 2; model_1.p[ 15 ].z :=   model_2.h / 2;
      model_1.p[ 16 ].x :=   model_2.l / 2; model_1.p[ 16 ].y := - model_2.w / 2; model_1.p[ 16 ].z :=   model_2.h / 2;

      model_1 := MoveXYZ( model_1, model_1.x, model_1.y, model_1.z, 1, 8 );

      model_1 := MoveXYZ( model_1, model_2.x, model_2.y, model_2.z, 9, 16 );

      for ii := 1 to 16 do
      begin
        model_a.p[ ii ].x := model_1.p[ ii ].x;
        model_a.p[ ii ].y := model_1.p[ ii ].y;
        model_a.p[ ii ].z := model_1.p[ ii ].z;
      end;

      SetColor( 14 ); DrawModel( model_a, area );

      model := MoveXYZ( model_a, model_a.x, model_a.y, model_a.z, 1, 16 );

      rz := 0;
      repeat Delay( 100 ) until KeyPressed; ReadKey;
      SetActivePage( 1 );
      SetVisualPage( 0 );
      repeat
        ClearDevice;
        XYZCenter( area );
        model := RotateXYZ( model, 0, 0, 1, 1, 16 );
        SetColor( 14 ); DrawModel( model, area );
        SetColor( 4 ); Circle( area.xc, area.zc, 2 );
        OutTextXY( area.xc + 3, area.zc + 3, '[ 0, 0 ]' );

        delay( 1 );

        SetColor( 4 );

        if ns = 0 then
        begin
          SetActivePage( 0 );
          SetVisualPage( 1 )
        end
        else
        begin
          SetActivePage( 1 );
          SetVisualPage( 0 )
        end;
        if ns = 0 then ns := 1 else ns := 0;
        until KeyPressed; ReadKey;
      repeat Delay( 100 ) until KeyPressed;
      CloseGraph;
    end;
  end.

The result of code:

img1

If you want to change octant, just change if statements in DrawFirstOctant procedure like:

    procedure DrawOctant( model_t: TModel; sp_t, ep_t: integer; area_t: TArea );
var
  mxyz: TArray2;
  a, b, a2, b2: TPoint3D;
  dx, dy, dz: real;
begin
  indx := 0;

  a2.x := model_t.p[ sp_t ].x;
  a2.y := model_t.p[ sp_t ].y;
  a2.z := model_t.p[ sp_t ].z;

  b2.x := model_t.p[ ep_t ].x;
  b2.y := model_t.p[ ep_t ].y;
  b2.z := model_t.p[ ep_t ].z;

  dx := - a2.x / ( b2.x - a2.x );
  dy := - a2.y / ( b2.y - a2.y );
  dz := - a2.z / ( b2.z - a2.z );

  if ( dx >= 0 ) and ( dx <= 1 ) then
  begin
    a.x := 0;
    a.y := dx * ( b2.y - a2.y ) + a2.y;
    a.z := dx * ( b2.z - a2.z ) + a2.z;
    if (a.y >= 0) and (a.z >= 0) then
    begin
      SetColor( 1 );
      points[ indx ] := a;
      Inc( indx );
    end;
  end;

  if ( dy >= 0 ) and ( dy <= 1 ) then
  begin
    a.x := dy * (b2.x - a2.x) + a2.x;
    a.y := 0;
    a.z := dy * (b2.z - a2.z) + a2.z;

    // x >= 0 changed to x <= 0
    if (a.x <= 0) and (a.z >= 0) then
    begin
      SetColor( 2 );
      points[ indx ] := a;
      Inc( indx );
    end;
  end;

  if ( dz >= 0 ) and ( dz <= 1 ) then
  begin
    a.x := dz * (b2.x - a2.x) + a2.x;
    a.y := dz * (b2.y - a2.y) + a2.y;
    a.z := 0;

    // x >= 0 changed to x <= 0
    if (a.x <= 0) and (a.y >= 0) then
    begin
      SetColor( 3 );
      points[ indx ] := a;
      Inc( indx );
    end;
  end;

  // x >= 0 changed to x <= 0
  if ( a2.x <= 0 ) and ( a2.y >= 0 ) and ( a2.z >= 0 ) then
  begin
    SetColor( 4 );
    a.x := a2.x;
    a.y := a2.y;
    a.z := a2.z;
    points[ indx ] := a;
    Inc( indx );
  end;

  // x >= 0 changed to x <= 0
  if ( b2.x <= 0 ) and ( b2.y >= 0 ) and ( b2.z >= 0 ) then
  begin
    SetColor( 5 );
    b.x := b2.x;
    b.y := b2.y;
    b.z := b2.z;
    points[ indx ] := b;
    Inc( indx );
  end;

  if (indx >= 2) then LineXYZ( points[ 0 ], points[ 1 ], model_t, area_t );

end;

The result of these changes:

img2

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.