help with Z-buffer algorithm

[rbc]

Dear Monks,

I almost have a z-buffer algorithm working for some 3D
graphics I am doing. But if you run the below script
you can see I don't have quite worked out correctly.

Please help! I know it looks like a lot of code but
I suspect the problem is in the sub fillZbuff or
sub buildET4Zbuff or the sub ProjectLine

#!/usr/bin/perl -w

use strict;
use Tk;
use Tk::Canvas;
use Getopt::Std;
use Math::Trig;
use Data::Dumper;
use Math::Round qw( nearest_floor nearest_ceil );

my $width = 500;
my $height = 500;
my $screenDist = 1000;
my $background = 'blue';
my $fill = 'yellow';
my $zmin = -10;
my %opts = ();
getopts( 'w:h:b:f:z:', \%opts );
if( $opts{w} ) { $width = $opts{w} ; }
if( $opts{h} ) { $height = $opts{h} ; }
if( $opts{b} ) { $background = $opts{b} ; }
if( $opts{f} ) { $fill = $opts{f} ; }
if( $opts{z} ) { $zmin = $opts{z} ; }


my $pidiv180 = atan(1)/45;
my $top     = MainWindow->new();
my $frame     = $top->Frame();
my $can = $top->Canvas( -width => $width, -height=> $height, -backgrou
+nd=>$background );

#my $rho = -1;  
my $rho = 0;  
my $theta = 90;  
my $phi = 0.0; 
my $rotateZ = 0.0;
my $rotateX = 0.0;
my $rotateY = 30.0;
my $TZ = 15;
my $TX = 0;
my $TY = 0;
my $N = 1;

my $colorSide_A = 240;
my $colorSide_B = 3333; # kind of red

my $x_center;
my $y_center;
my $YMAX;
my $per;
my $clipVol;

my $y_max = 1;
my $y_min = -1;
my @ZBUFFER;

sub clear{ $can->delete( 'all' ); }
sub doit {
    $x_center = $can->reqwidth()/2.0;
    $y_center = $can->reqheight()/2.0;
    $YMAX = $can->reqheight();
    $per = new Perspective( $rho, $theta*$pidiv180, $phi*$pidiv180 );
    $clipVol = new Clip3D( $zmin );

    for( my $i=0; $i<$can->reqwidth(); $i++ ) {
        for( my $j=0; $j<$can->reqheight(); $j++ ) {
            $ZBUFFER[$i][$j] = 9999999;
        }
    }

    my @cube = (
        new Vector3D(  1, -1, -1 ), # 0 A
        new Vector3D(  1,  1, -1 ), # 1 B
        new Vector3D( -1,  1, -1 ), # 2 C
        new Vector3D( -1, -1, -1 ), # 3 D
        new Vector3D(  1, -1,  1 ), # 4 E
        new Vector3D(  1,  1,  1 ), # 5 F
        new Vector3D( -1,  1,  1 ), # 6 G
        new Vector3D( -1, -1,  1 )  # 7 H
    );

    my @negative_y_axis = (
        new Vector3D(  0,    0, 0.1 ), # 0 
        new Vector3D(  0,  -10, 0.1 ), # 1 
    );
    my @positive_y_axis = (
        new Vector3D(  0,    0, 0.1 ), # 0 
        new Vector3D(  0,   10, 0.1 ), # 1 
    );
    my @negative_x_axis = (
        new Vector3D(    0,  0, 0.1 ), # 0 
        new Vector3D(  -10,  0, 0.1 ), # 1 
    );
    my @positive_x_axis = (
        new Vector3D(   0,   0, 0.1 ), # 0 
        new Vector3D(  10,   0, 0.1 ), # 1 
    );

    for( my $i=0; $i<$N; $i++ ) {
        foreach my $v ( @cube ) { $v->rotateZ( $rotateZ * $pidiv180 );
+ }
        foreach my $v ( @cube ) { $v->rotateX( $rotateX * $pidiv180 );
+ }
        foreach my $v ( @cube ) { $v->rotateY( $rotateY * $pidiv180 );
+ }
        foreach my $v ( @cube ) { $v->translate( new Vector3D($TX, $TY
+, $TZ) ); }

        my @zero = (
            new Vector3D(  $cube[0]->getx()    + 0.05, $cube[0]->gety(
+)      , $cube[0]->getz() ), # 0 
            new Vector3D(  $cube[0]->getx() + 0.1, $cube[0]->gety()   
+   , $cube[0]->getz() ), # 1 
            new Vector3D(  $cube[0]->getx() + 0.1, $cube[0]->gety() + 
+0.1, $cube[0]->getz() ), # 1 
            new Vector3D(  $cube[0]->getx() + 0.05, $cube[0]->gety() +
+ 0.1, $cube[0]->getz() ), # 1 
            new Vector3D(  $cube[0]->getx() + 0.05, $cube[0]->gety()  
+    , $cube[0]->getz() ), # 0 
        );

        my @one = (
            new Vector3D(  $cube[1]->getx() + 0.1, $cube[1]->gety()   
+   , $cube[1]->getz() ), # 1 
            new Vector3D(  $cube[1]->getx() + 0.1, $cube[1]->gety() + 
+0.1, $cube[1]->getz() ), # 1 
        );

        my @two = (
            new Vector3D(  $cube[2]->getx() - 0.10, $cube[2]->gety() +
+ 0.10, $cube[2]->getz() ), # 1 
            new Vector3D(  $cube[2]->getx() - 0.05, $cube[2]->gety() +
+ 0.10, $cube[2]->getz() ), # 1 
            new Vector3D(  $cube[2]->getx()    - 0.05, $cube[2]->gety(
+) + 0.05, $cube[2]->getz() ), # 0 
            new Vector3D(  $cube[2]->getx()    - 0.10, $cube[2]->gety(
+) + 0.05, $cube[2]->getz() ), # 0 
            new Vector3D(  $cube[2]->getx()    - 0.10, $cube[2]->gety(
+)       , $cube[2]->getz() ), # 0 
            new Vector3D(  $cube[2]->getx() - 0.05, $cube[2]->gety()  
+     , $cube[2]->getz() ), # 1 
        );

        my @three = (
            new Vector3D(  $cube[3]->getx() - 0.10, $cube[3]->gety() +
+ 0.10, $cube[3]->getz() ), # 1 
            new Vector3D(  $cube[3]->getx() - 0.05, $cube[3]->gety() +
+ 0.10, $cube[3]->getz() ), # 1 
            new Vector3D(  $cube[3]->getx()    - 0.05, $cube[3]->gety(
+) + 0.05, $cube[3]->getz() ), # 0 
            new Vector3D(  $cube[3]->getx()    - 0.10, $cube[3]->gety(
+) + 0.05, $cube[3]->getz() ), # 0 
            new Vector3D(  $cube[3]->getx()    - 0.05, $cube[3]->gety(
+) + 0.05, $cube[3]->getz() ), # 0 
            new Vector3D(  $cube[3]->getx()    - 0.05, $cube[3]->gety(
+)       , $cube[3]->getz() ), # 0 
            new Vector3D(  $cube[3]->getx() - 0.10, $cube[3]->gety()  
+     , $cube[3]->getz() ), # 1 
        );

        my @four = (
            new Vector3D(  $cube[4]->getx() + 0.05, $cube[4]->gety() +
+ 0.10, $cube[4]->getz() ), # 1 
            new Vector3D(  $cube[4]->getx()    + 0.05, $cube[4]->gety(
+) + 0.05, $cube[4]->getz() ), # 4 
            new Vector3D(  $cube[4]->getx()    + 0.10, $cube[4]->gety(
+) + 0.05, $cube[4]->getz() ), # 3 
            new Vector3D(  $cube[4]->getx() + 0.10, $cube[4]->gety() +
+ 0.10, $cube[4]->getz() ), # 2 
            new Vector3D(  $cube[4]->getx()    + 0.10, $cube[4]->gety(
+)       , $cube[4]->getz() ), # 6 
        );

        my @five = (
            new Vector3D(  $cube[5]->getx() + 0.10, $cube[5]->gety() +
+ 0.10, $cube[5]->getz() ), # 1 
            new Vector3D(  $cube[5]->getx() + 0.05, $cube[5]->gety() +
+ 0.10, $cube[5]->getz() ), # 1 
            new Vector3D(  $cube[5]->getx()    + 0.05, $cube[5]->gety(
+) + 0.05, $cube[5]->getz() ), # 0 
            new Vector3D(  $cube[5]->getx()    + 0.10, $cube[5]->gety(
+) + 0.05, $cube[5]->getz() ), # 0 
            new Vector3D(  $cube[5]->getx()    + 0.10, $cube[5]->gety(
+)       , $cube[5]->getz() ), # 0 
            new Vector3D(  $cube[5]->getx() + 0.05, $cube[5]->gety()  
+     , $cube[5]->getz() ), # 1 
        );

        my @six = (
            new Vector3D(  $cube[6]->getx() - 0.05, $cube[6]->gety() +
+ 0.10, $cube[6]->getz() ), # 1 
            new Vector3D(  $cube[6]->getx() - 0.10, $cube[6]->gety() +
+ 0.10, $cube[6]->getz() ), # 1 
            new Vector3D(  $cube[6]->getx()    - 0.10, $cube[6]->gety(
+) + 0.05, $cube[6]->getz() ), # 0 
            new Vector3D(  $cube[6]->getx()    - 0.05, $cube[6]->gety(
+) + 0.05, $cube[6]->getz() ), # 0 
            new Vector3D(  $cube[6]->getx()    - 0.05, $cube[6]->gety(
+)       , $cube[6]->getz() ), # 0 
            new Vector3D(  $cube[6]->getx() - 0.10, $cube[6]->gety()  
+     , $cube[6]->getz() ), # 1 
            new Vector3D(  $cube[6]->getx()    - 0.10, $cube[6]->gety(
+) + 0.05, $cube[6]->getz() ), # 0 
        );

        my @seven = (
            new Vector3D(  $cube[7]->getx() - 0.10, $cube[7]->gety() +
+ 0.10, $cube[7]->getz() ), # 1 
            new Vector3D(  $cube[7]->getx() - 0.05, $cube[7]->gety() +
+ 0.10, $cube[7]->getz() ), # 1 
            new Vector3D(  $cube[7]->getx()    - 0.05, $cube[7]->gety(
+)       , $cube[7]->getz() ), # 0 
        );

    
        DrawPolygon ( [ $cube[0], $cube[1], $cube[5], $cube[4], $cube[
+0] ], $colorSide_A ); #side A
        DrawPolygon ( [ $cube[4], $cube[5], $cube[6], $cube[7], $cube[
+4] ], 140 ); #side B
        DrawPolygon ( [ $cube[7], $cube[6], $cube[2], $cube[3], $cube[
+7] ], 901 ); #side C
        DrawPolygon ( [ $cube[6], $cube[2], $cube[1], $cube[5], $cube[
+6] ], 56 );  #side D
        DrawPolygon ( [ $cube[0], $cube[4], $cube[7], $cube[3], $cube[
+0] ], 591 ); #side E
        drawShape( \@zero );
        drawShape( \@one );
        drawShape( \@two );
        drawShape( \@three );
        drawShape( \@four );
        drawShape( \@five );
        drawShape( \@six );
        drawShape( \@seven );
#        drawShape( \@negative_y_axis, 'red' );
#        drawShape( \@positive_y_axis, 'white' );
#        drawShape( \@negative_x_axis, 'black' );
#        drawShape( \@positive_x_axis, 'white' );
    } # end for loop
}

sub drawShape { 
    my $shape = shift; # ref to array of vector3D
    my $color = shift || 'red';

    my @s = @{$shape};

    my $v1 = pop(@s);
    while (@s) {
        my $v2 = pop(@s);
        DrawLine( $v1, $v2, $color ); #, $per, $screenDist, $x_center,
+ $y_center, $clipVol );
        $v1 = $v2;
    }
}

sub DrawPolygon {
    my $points = shift; # ref to array of Vector3Ds
    my $color  = shift;

    my @edges;
    my @pts = @{$points};
    my $curr = $pts[0];

    for ( my $i=1; $i<=$#pts; $i++ ) {
        my $next = $pts[$i];
        my $ptPair = ProjectLine( $curr, $next );
        push( @edges, $ptPair );
        $curr = $next;
    }
    my $polygon = new PolygonZbuffer( \@edges, $can, $color );
    $polygon->fillZbuff(\@ZBUFFER);
}

sub ProjectLine {
    my $v1 = shift;
    my $v2 = shift;
    my $color = shift || $fill;

    my( $x1, $y1, $x2, $y2, $visible );

    my $X1 = $v1->getx();
    my $Y1 = $v1->gety();
    my $Z1 = $v1->getz();
    my $X2 = $v2->getx();
    my $Y2 = $v2->gety();
    my $Z2 = $v2->getz();
    $visible = $clipVol->Clip ( \$X1, \$Y1, \$Z1, \$X2, \$Y2, \$Z2);
    if ( $visible == 1 ) {
        my $V1 = new Vector3D( $X1, $Y1, $Z1 );
        my $V2 = new Vector3D( $X2, $Y2, $Z2 );
        $per->perspective( $V1, \$x1, \$y1 ); 
        $per->perspective( $V2, \$x2, \$y2 ); 

        my $A = new Vector2D ( 
            nearest_ceil( 1, $screenDist * $x1 + $x_center ), 
            nearest_floor( 1, $YMAX - ($screenDist * $y1 + $y_center))
        );
        my $B = new Vector2D ( 
            nearest_ceil( 1, $screenDist * $x2 + $x_center ), 
            nearest_floor( 1, $YMAX - ($screenDist * $y2 + $y_center))
        );
        #my @AB = ( $A, $B );
        my $rec = {
            #edge => @AB,
            edge => [$A, $B],
            dx   => $X1 - $X2,
            dz   => $Z1 - $Z2,
#            z    => $Z1
            z    => ( $X1 < $X2 ) ? ($Z1) : ($Z2)
        };
        return $rec;
    }
    return undef;
}

sub DrawLine {
    my $v1 = shift;
    my $v2 = shift;
    my $color = shift || $fill;

    my( $x1, $y1, $x2, $y2, $visible );

    my $X1 = $v1->getx();
    my $Y1 = $v1->gety();
    my $Z1 = $v1->getz();
    my $X2 = $v2->getx();
    my $Y2 = $v2->gety();
    my $Z2 = $v2->getz();
    $visible = $clipVol->Clip ( \$X1, \$Y1, \$Z1, \$X2, \$Y2, \$Z2);
    if ( $visible == 1 ) {
        my $V1 = new Vector3D( $X1, $Y1, $Z1 );
        my $V2 = new Vector3D( $X2, $Y2, $Z2 );
        $per->perspective( $V1, \$x1, \$y1 ); 
        $per->perspective( $V2, \$x2, \$y2 ); 

        $can->create( 'line',
            $screenDist * $x1 + $x_center,
            $YMAX - ($screenDist * $y1 + $y_center),
            $screenDist * $x2 + $x_center,
            $YMAX - ($screenDist * $y2 + $y_center),
            -fill => $color
        );
        my $A = new Vector2D ( 
            nearest_ceil( 1, $screenDist * $x1 + $x_center ), 
            nearest_floor( 1, $YMAX - ($screenDist * $y1 + $y_center))
        );
        my $B = new Vector2D ( 
            nearest_ceil( 1, $screenDist * $x2 + $x_center ), 
            nearest_floor( 1, $YMAX - ($screenDist * $y2 + $y_center))
        );
        my @AB = ( $A, $B );
        return @AB;
    }
    return undef;
}


$can->packAdjust( -side => 'left', -fill => 'both', -delay => 1 );
$frame->pack( 
    -side     => 'left', 
    -fill     => 'y', 
    -expand => 'y', 
    -anchor => 'w' );

my $mbutton = $frame->Button( 
    -relief     => "groove", 
    -text         => "Viewing Dist rho = EO " )->pack( anchor => 'w' )
+;
my $mentry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$rho)->form( 
    -left => [$mbutton,0] );

my $nbutton = $frame->Button( 
    -relief     => "groove", 
    -text         => "theta = ")->form( 
    -top => [$mbutton,0] );
my $nentry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$theta)->form( 
    -left => [$nbutton,0],
    -top => [$mbutton,0] );

my $phibutton = $frame->Button( 
    -relief     => "groove", 
    -text         => "phi = ", 
    )->form( -top => [$nbutton,0] );
my $phientry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$phi) ->form( 
    -left => [$phibutton,0],
    -top => [$nbutton,0] );
my $rotZbutton = $frame->Button( 
    -relief     => "groove", 
    -text         => "rotZ = ", 
    )->form( -top => [$phibutton,0] );
my $rotZentry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$rotateZ) ->form( 
    -left => [$rotZbutton,0],
    -top => [$phibutton,0] );
my $rotXbutton = $frame->Button( 
    -relief     => "groove", 
    -text         => "rotX = ", 
    )->form( -top => [$rotZbutton,0] );
my $rotXentry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$rotateX) ->form( 
    -left => [$rotXbutton,0],
    -top => [$rotZbutton,0] );
my $rotYbutton = $frame->Button( 
    -relief     => "groove", 
    -text         => "rotY = ", 
    )->form( -top => [$rotXbutton,0] );
my $rotYentry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$rotateY) ->form( 
    -left => [$rotYbutton,0],
    -top => [$rotXbutton,0] );
#####

my $TZbutton = $frame->Button( 
    -relief     => "groove", 
    -text         => "TX = ", 
    )->form( -top => [$rotYbutton,0] );
my $TZentry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$TX) ->form( 
    -left => [$TZbutton,0],
    -top => [$rotYbutton,0] );
my $TXbutton = $frame->Button( 
    -relief     => "groove", 
    -text         => "TY = ", 
    )->form( -top => [$TZbutton,0] );
my $TXentry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$TY) ->form( 
    -left => [$TXbutton,0],
    -top => [$TZbutton,0] );
my $TYbutton = $frame->Button( 
    -relief     => "groove", 
    -text         => "TZ = ", 
    )->form( -top => [$TXbutton,0] );
my $TYentry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$TZ) ->form( 
    -left => [$TYbutton,0],
    -top => [$TXbutton,0] );


my $dist_button = $frame->Button( 
    -relief     => "groove", 
    -text         => "Dist = ", 
    )->form( -top => [$TYbutton,0] );
my $dist_entry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$screenDist) ->form( 
    -left => [$dist_button,0],
    -top => [$TYbutton,0] );

my $N_button = $frame->Button( 

    -relief     => "groove", 
    -text         => "N = ", 
    )->form( -top => [$dist_button,0] );
my $N_entry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$N) ->form( 
    -left => [$N_button,0],
    -top => [$dist_button,0] );

my $zmin_button = $frame->Button( 
    -relief     => "groove", 
    -text         => "zmin = ", 
    )->form( -top => [$N_button,0] );
my $zmin_entry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$zmin) ->form( 
    -left => [$zmin_button,0],
    -top => [$N_button,0] );

my $doButton = $frame->Button( 
    -relief     => "groove", 
    -text         => "Draw", 
    -command    => \&doit  )->form( 
    -top => [$zmin_button,0] );

my $clearButton = $frame->Button( 
    -relief     => "groove", 
    -text         => "Clear", 
    -command    => \&clear  )->form( 
    -top         => [$zmin_button,0],
    -left         => [$doButton,0] );

my $colorAButton = $frame->Button( 
    -relief     => "groove", 
    -text         => "Color Side A = ", 
    )->form( -top => [$clearButton,0] );
my $colorAEntry = $frame->Entry( 
    -width     => 10,
    -textvariable     => \$colorSide_A) ->form( 
    -left => [$colorAButton,0],
    -top => [$clearButton,0] );

MainLoop;

BEGIN {
#include module Vector3D
{
package Vector3D;
use strict;
use overload
      "-"    => \&minus,
      "+"    => \&plus,
      "*"    => \&mult;

sub new  {
    my ($pkg,$x,$y,$z) = @_;
    bless {
        _x => $x,
        _y => $y,
        _z => $z
    }, $pkg;
}

sub getx { my $obj = shift; return $obj->{_x}; }
sub gety { my $obj = shift; return $obj->{_y}; }
sub getz { my $obj = shift; return $obj->{_z}; }
sub getxyz { 
    my $obj = shift; 
    my @xyz = ( $obj->getx(), $obj->gety(), $obj->getz() );
    return @xyz;
}

sub setx { my $obj = shift; $obj->{_x} = shift; }
sub sety { my $obj = shift; $obj->{_y} = shift; }
sub setz { my $obj = shift; $obj->{_z} = shift; }
sub setxyz { 
    my $obj = shift; 
    $obj->setx(shift);
    $obj->sety(shift);
    $obj->setz(shift);
}


sub plus {
    my $u = shift;
    my $v = shift;
    return new Vector3D ( 
        $u->getx() + $v->getx(),
        $u->gety() + $v->gety(),
        $u->getz() + $v->getz()
    );
}

sub minus {
    my $u = shift;
    my $v = shift;
    return new Vector3D ( 
        $u->getx() - $v->getx(),
        $u->gety() - $v->gety(),
        $u->getz() - $v->getz()
    );
}

sub mult {
    my $v = shift;
    my $c = shift;
    return new Vector3D ( 
        $c * $v->getx(),
        $c * $v->gety(),
        $c * $v->getz()
    );
}

sub incr {
    my $u = shift;
    my $v = shift;
    $u->{_x} += $v->{_x};
    $u->{_y} += $v->{_y};
    $u->{_z} += $v->{_z};
    return $u;
}

sub decr {
    my $u = shift;
    my $v = shift;
    $u->{_x} -= $v->{_x};
    $u->{_y} -= $v->{_y};
    $u->{_z} -= $v->{_z};
    return $u;
}

sub scale {
    my $v = shift;
    my $c = shift;
    $v->{_x} *= $c;
    $v->{_y} *= $c;
    $v->{_z} *= $c;
    return $v;
}

sub translate {
    my $u = shift;
    my $v = shift;
    $u->{_x} += $v->getx();
    $u->{_y} += $v->gety();
    $u->{_z} += $v->getz();
}

sub dotproduct {
    my $obj = shift; #vector
    my $b     = shift; #vector
    return     $obj->getx() * $b->getx()     + 
        $obj->gety() * $b->gety()     + 
        $obj->getz() * $b->getz();
}

sub abs {
    my $obj = shift; #vector
    return     sqrt (    $obj->getx() * $obj->getx()+ 
            $obj->gety() * $obj->gety()+ 
            $obj->getz() * $obj->getz());
}

sub crossproduct {
    my $obj = shift; #vector
    my $b     = shift; #vector
    return     new Vector3D( 
        $obj->gety() * $b->getz() - $obj->getz() * $b->gety(),
        $obj->getz() * $b->getx() - $obj->getx() * $b->getz(),
        $obj->getx() * $b->gety() - $obj->gety() * $b->getx()
    );
}

sub rotateZ {
    my $P = shift; #vector
    my $phi = shift;
    my $cosphi = cos( $phi );
    my $sinphi = sin( $phi );
    my $dx = $P->{_x};
    my $dy = $P->{_y};
    $P->setx( $dx * $cosphi - $dy * $sinphi );
    $P->sety( $dx * $sinphi + $dy * $cosphi );
}

sub rotateY {
    my $P = shift; #vector
    my $phi = shift;
    my $cosphi = cos( $phi );
    my $sinphi = sin( $phi );
    my $dx = $P->{_x};
    my $dz = $P->{_z};
    $P->setx( $dx * $cosphi - $dz * $sinphi );
    $P->setz( $dx * $sinphi + $dz * $cosphi );
}

sub rotateX {
    my $P = shift; #vector
    my $phi = shift;
    my $cosphi = cos( $phi );
    my $sinphi = sin( $phi );
    my $dy = $P->{_y};
    my $dz = $P->{_z};
    $P->sety( $dy * $cosphi - $dz * $sinphi );
    $P->setz( $dy * $sinphi + $dz * $cosphi );
}

sub print {
    my $v = shift; #vector
    print     "( " . $v->getx() . 
        ", " . $v->gety() . 
        ", " . $v->getz() . ")\n";
}

1;
} #end package Vector3D
#include module Vector2D
{
package Vector2D;
#####################################################
### Copyright (c) 2002 Russell B Cecala. All rights
### reserved.  This program is free software; you can
### redistribute it and/or modify it under the same 
### terms as Perl itself.
#####################################################
use strict;
use overload
      "-"    => \&minus,
      "+"    => \&plus,
      "*"    => \&mult,
      "bool" => \&bool;

sub new  {
    my ($pkg,$x,$y) = @_;
    bless {
        _x => $x,
        _y => $y
    }, $pkg;
}

sub getx { my $obj = shift; return $obj->{_x}; }
sub gety { my $obj = shift; return $obj->{_y}; }
sub setx { my $obj = shift; my $v = shift; $obj->{_x} = $v; }
sub sety { my $obj = shift; my $v = shift; $obj->{_y} = $v; }

sub getxy { 
    my $obj = shift; 
    my @xy = ( $obj->getx(), $obj->gety() );
    return @xy;
}

sub plus {
    my $u = shift;
    my $v = shift;
    return new Vector2D ( 
        $u->getx() + $v->getx(),
        $u->gety() + $v->gety()
    );
}

sub minus {
    my $u = shift;
    my $v = shift;
    return new Vector2D ( 
        $u->getx() - $v->getx(),
        $u->gety() - $v->gety()
    );
}

sub mult {
    my $v = shift;
    my $c = shift;
    return new Vector2D ( 
        $c * $v->getx(),
        $c * $v->gety()
    );
}

sub bool { return defined( shift ); }

sub incr {
    my $u = shift;
    my $v = shift;
    $u->{_x} += $v->{_x};
    $u->{_y} += $v->{_y};
    return $u;
}

sub decr {
    my $u = shift;
    my $v = shift;
    $u->{_x} -= $v->{_x};
    $u->{_y} -= $v->{_y};
    return $u;
}

sub scale {
    my $v = shift;
    my $c = shift;
    $v->{_x} *= $c;
    $v->{_y} *= $c;
    return $v;
}

sub rotate {
    my $P = shift; #vector
    my $C = shift; #vector
    my $cosphi = shift;
    my $sinphi = shift;
    my $dx = $P->{_x} - $C->{_x};
    my $dy = $P->{_y} - $C->{_y};
    return new Vector2D ( 
        $C->{_x} + $dx * $cosphi - $dy * $sinphi,
        $C->{_y} + $dx * $sinphi + $dy * $cosphi
    );
}

sub print {
    my $v = shift; #vector
    print "( " . $v->getx() . ", " . $v->gety() . ")\n";
}


1;
} #end modeult Vector2D
# include Perspective module
{
package Perspective;
use strict;

use Math::Trig;

sub new  {
    my ($pkg,$rho,$theta,$phi) = @_;
    bless {
        _rho => $rho,
        _theta => $theta,
        _phi => $phi,
        _v11 => ( -sin( $theta ) ),
        _v12 => ( -cos( $phi ) * cos( $theta ) ),
        _v13 => ( -sin( $phi ) * cos( $theta ) ),
        _v21 => (  cos( $theta ) ),
        _v22 => ( -cos( $phi ) * sin( $theta ) ),
        _v23 => ( -sin( $phi ) * sin( $theta ) ),
        _v32 => (  sin( $phi ) ),
        _v33 => ( -cos( $phi ) ),
        _v43 => ( $rho )
    }, $pkg;
}

sub getrho     { my $obj = shift; return $obj->{_rho}; }
sub gettheta     { my $obj = shift; return $obj->{_theta}; }
sub getphi     { my $obj = shift; return $obj->{_phi}; }
sub getv11     { my $obj = shift; return $obj->{_v11}; }
sub getv12     { my $obj = shift; return $obj->{_v12}; }
sub getv13     { my $obj = shift; return $obj->{_v13}; }
sub getv21     { my $obj = shift; return $obj->{_v21}; }
sub getv22     { my $obj = shift; return $obj->{_v22}; }
sub getv23     { my $obj = shift; return $obj->{_v23}; }
sub getv32     { my $obj = shift; return $obj->{_v32}; }
sub getv33     { my $obj = shift; return $obj->{_v33}; }
sub getv43     { my $obj = shift; return $obj->{_v43}; }

sub setrho     { my $obj = shift; $obj->{_rho} = shift; }
sub settheta     { my $obj = shift; $obj->{_theta} = shift; }
sub setphi     { my $obj = shift; $obj->{_phi} = shift; }
sub setv11     { my $obj = shift; $obj->{_v11} = shift; }
sub setv12     { my $obj = shift; $obj->{_v12} = shift; }
sub setv13     { my $obj = shift; $obj->{_v13} = shift; }
sub setv21     { my $obj = shift; $obj->{_v21} = shift; }
sub setv22     { my $obj = shift; $obj->{_v22} = shift; }
sub setv23     { my $obj = shift; $obj->{_v23} = shift; }
sub setv32     { my $obj = shift; $obj->{_v32} = shift; }
sub setv33     { my $obj = shift; $obj->{_v33} = shift; }
sub setv43     { my $obj = shift; $obj->{_v43} = shift; }

sub eyecoord {
    my $obj = shift;
    my $pw = shift;
    my $pe = shift;
    my $x = $pw->getx();
    my $y = $pw->gety();
    my $z = $pw->getz();
    my $v11 = $obj->getv11();
    my $v12 = $obj->getv12();
    my $v13 = $obj->getv13();
    my $v21 = $obj->getv21();
    my $v22 = $obj->getv22();
    my $v23 = $obj->getv23();
    my $v32 = $obj->getv32();
    my $v33 = $obj->getv33();
    my $v43 = $obj->getv43();
    $pe->setx( $v11 * $x + $v21 * $y );
    $pe->sety( $v12 * $x + $v22 * $y + $v32 * $z);
    $pe->setz( $v13 * $x + $v23 * $y + $v33 * $z + $v43);
}

sub perspective {
    my $obj = shift;
    my $p    = shift;
    my $refpx = shift;
    my $refpy = shift;
    my $pe     = new Vector3D( 0.0, 0.0, 0.0 );

    $obj->eyecoord ( $p, $pe );
    $$refpx = $pe->getx() / (1E-7 + $pe->getz());
    $$refpy = $pe->gety() / (1E-7 + $pe->getz());
}    

1;
} #end Perspective
# include Clip3D;
{
package Clip3D;
#####################################################
### Copyright (c) 2002 Russell B Cecala. All rights
### reserved.  This program is free software; you can
### redistribute it and/or modify it under the same 
### terms as Perl itself.
#####################################################
use strict;
#use Tk;

sub new  {
    my ($pkg,$zmin,$tag) = @_;
    bless {
        _zmin     => $zmin,
        _tag     => $tag || 'CLIPVOL'
    }, $pkg;
}

sub setzmin {
    my $obj     = shift;
    my $zmin    = shift;
    $obj->{_zmin}     = $zmin;
}

sub settag {
    my $obj     = shift;
    my $tag    = shift;
    $obj->{_tag}     = $tag;
}

sub getzmin { my $obj = shift; return $obj->{_zmin}; }
sub gettag { my $obj = shift; return $obj->{_tag}; }

sub Clip  {
    # refs to scalars
    my $pkg     = shift;
    my $x0         = shift;
    my $y0         = shift;
    my $z0         = shift;
    my $x1         = shift;
    my $y1         = shift;
    my $z1         = shift;

    #scalar
    my $zmin     = $pkg->getzmin();

    my $accept     = 0;        # assume that line is not visiable
    my $tmin    = 0;
    my $tmax    = 1;
    my $dx        = $$x1 - $$x0;
    my $dz        = $$z1 - $$z0;

    if ( clipT( $dx+$dz, -$$x0-$$z0, \$tmin, \$tmax ) ) {             
+   # Right side
        if ( clipT( -$dx+$dz, $$x0-$$z0, \$tmin, \$tmax ) ) {         
+   # Left side
            my $dy = $$y1 - $$y0;
            if ( clipT( -$dy+$dz, $$y0-$$z0, \$tmin, \$tmax ) ) {     
+   # Bottom side
                if ( clipT( $dy+$dz, -$$y0-$$z0, \$tmin, \$tmax ) ) { 
+   # Top side
                    # part of line is in -z <= x <= z, -z <= y <= z
                    if ( clipT( $dz, -$$z0 + $zmin, \$tmin, \$tmax ) )
+ {        # Front
                        if ( clipT( -$dz, -$$z0-1, \$tmin, \$tmax ) ) 
+{        # Back
                            # part of line is visible in -z <= x <= z,
+ -z <= y <= z, -1 <= x <= $zmin
                            $accept = 1;
                            # If end pt 1 (t=1) is not in region, comp
+ute intersection
                            if ( $tmax < 1 ) {
                                $$x1 = $$x0 + $tmax * $dx;
                                $$y1 = $$y0 + $tmax * $dy;
                                $$z1 = $$z0 + $tmax * $dz;
                            }
                            # If end pt 0 (t=0) is not in region, comp
+ute intersection
                            if ( $tmin > 0 ) {
                                $$x0 = $$x0 + $tmin * $dx;
                                $$y0 = $$y0 + $tmin * $dy;
                                $$z0 = $$z0 + $tmin * $dz;
                            }
                        }
                    }
                }
            }
        }
    }
    return $accept;
}


###################################################################
###
###    sub clipT is used by the sub clipLine defined in this 
###    module.  clipT is based on pseudo code presented in 
###    Foley, van Dam, Feiner, and Hughes's book "Computer Graphics: 
###    Principles and Practive" 2nd Edition pages on page 122. The 
###    following comment is taken almost verbatum from that book. 
###
###    clipT computes a new value of tE or tL for an interior
###    intersection of a line segment and an edge.  Parameter
###    demon is -dotProduct(Ni, D), which reduces to 
###    +/- deltaX, deltaY for upright rectangles; its sign determines
###    whether the intersection is PE or PL.  Parameter num is 
###    dotProduct( Ni, Po-Pei) for a particular edge/line
###    combination, which reduces to directed horizontal and 
###    vertical distance from Po to an edg; its sign determines
###    visibility of Po and is used to trivially reject, false is 
###    returned; if it cannot be, true is returned and the value
###    of tE or tL is adjusted, if needed, for the portian of the
###    segment that is inside the edge.
###    
###################################################################
sub clipT {
    my $denom     = shift;
    my $num        = shift;
    my $tE        = shift; # ref to scalar
    my $tL        = shift; # ref to scalar
    my $t;
    my $accept     = 1;    # 1 implie TRUE. 0 implies FALSE
    if ( $denom > 0 ) {
        $t = $num/$denom;
        if     ( $t > $$tL ) {
            $accept = 0;
        } elsif ( $t > $$tE ) {
            $$tE = $t;
        }
    } elsif ( $denom < 0 ) {
        $t = $num/$denom;
        if     ( $t < $$tE ) {
            $accept = 0;
        } elsif ( $t < $$tL ) {
            $$tL = $t;
        }
    } else {
        if ( $num > 0 ) {
            $accept = 0;
        }
    }
    return $accept;
}

1;
} # end Clip3D;

#include PolygonZbuffer;
{
package PolygonZbuffer;
use strict;
use Exporter;

#use Vector3D;
use Math::Round qw( nearest_floor nearest_ceil );
use Tk;
use Tk::Canvas;
use Data::Dumper;

sub new  {
    my ($pkg, $edges, $canvas, $color) = @_;
    my $highestY  = getHighestY($edges);

    bless {
        edges     => $edges,     # ref to array of edge info hash
        ET        => undef,    # edge table
        highestY    => $highestY,
        can        => $canvas,    #Tk canvas
        color        => $color
    }, $pkg;
}

sub print {
    my $pkg     = shift;

    foreach my $e ( @{$pkg->{edges}} ) {
        @{$e}->[0]->print();
        @{$e}->[1]->print();
    }
}

sub dumpET {
    my $pkg     = shift;
    my $et         = $pkg->{ET};
    my $highestY     = $pkg->{highestY};

    for my $i (0..$highestY-1) {
        if ( @{$et}[$i] ) {
            print "et[$i] = ";
            for my $list ( @{$et}[$i] ) {
                for my $r ( @{$list} ) {
                    print "{" . %{$r}->{Ymax} . "|" . %{$r}->{Xbot} . 
+"|" . %{$r}->{invSlope} . "}" ;
                }
            }
            print "\n";
        } else {
            print "et[$i] = NULL\n";
        }
    }
}


sub buildET4Zbuff {
    my $pkg = shift;
    # each entry in the Edge Table (ET) contains the Ymax coordinate o
+f the edge,
    # the x cooridnate of the bottom endpoint Xbot and the x increment
+ 
    # used in the stepping from one scan lime to the next 1/m
    for my $e (@{$pkg->{edges}}) {
        my $y    = ( $e->{edge}->[0]->gety() <   $e->{edge}->[1]->gety
+() ) ? $e->{edge}->[0]->gety() : $e->{edge}->[1]->gety() ;
        my $Ymax = ( $e->{edge}->[0]->gety() >=  $e->{edge}->[1]->gety
+() ) ? $e->{edge}->[0]->gety() : $e->{edge}->[1]->gety() ;
        my $z      = $e->{z};
        my $Xbot = ( $e->{edge}->[0]->gety() <  $e->{edge}->[1]->gety(
+) ) ? $e->{edge}->[0]->getx() : $e->{edge}->[1]->getx() ;
        my $dz   = $e->{dz};
        my $dx   = $e->{dx};

        my $invSlope     = &calcOneOverSlope($e);
        my $rec = {
            Ymax         => $Ymax,
            Xbot         => $Xbot,
            invSlope    => $invSlope,
            dz        => $dz,
            dx        => $dx,
            z        => $z,
        };
        push( @{$pkg->{ET}[$y]}, $rec );
    }
    my $highestY = $pkg->{highestY};
    for my $i (0..$highestY-1) { if ( $pkg->{ET}[$i] ) { return $i; } 
+}    
}

sub fillZbuff {
    my $pkg = shift;
    my $zbuffer = shift; # ref to 2D array

    my $color = $pkg->{color};
    my $y     = $pkg->buildET4Zbuff();
    my @ET     = @{$pkg->{ET}};
    my @AET;    # Active Edge Table
    
    do {
        #print "================== doing scan line $y ================
+\n";
        # Move from ET bucket y to the AET those edges whose Ymin = y
        if ( $ET[$y] ) {
            while( @{$ET[$y]} ) { 
                my $e = pop( @{$ET[$y]} ); 
                push( @AET, $e );
            }
            $ET[$y] = undef;
        }
    
        # then sort AET on x
        @AET = sort{ %{$a}->{Xbot} <=> %{$b}->{Xbot} } @AET;
    
        my $last; 
        for ( my $i=0; $i<$#AET+1; ) {
            my $X1;
            my $X2;
            my $x1 = $AET[$i++];
            my $x2 = $AET[$i++];
            my $left;
            my $right;
            if ( $x2 ) {
                $last = $x2;
                $X1 = nearest_ceil(1,%{$x1}->{Xbot});
                $X2 = nearest_floor(1,%{$x2}->{Xbot});
                $left = $x1;
                $right = $x2;
            } else {
                $X1 = nearest_ceil(1,%{$last}->{Xbot});
                $X2 = nearest_floor(1,%{$x1}->{Xbot});
                $left = $last;
                $right = $x1;
            }
#            my $z = %{$left}->{z};
            my $z = nearest_ceil( 1, %{$left}->{z} ); 
            for my $x ( $X1..$X2 ) { 
#$z += %{$left}->{dz}/ (%{$left}->{dx} + 1E-7) ;
#$z += %{$left}->{dz};
                $z += nearest_ceil( 1, %{$left}->{dz} );
                if( $z <= @{$zbuffer}->[$x]->[$y] ) {
                    $pkg->setPixel( $x, $y, $color ); 
                    @{$zbuffer}->[$x]->[$y] = $z; 
                }
            }
        }
        my @AET_copy; # = @AET;
        while( @AET ) {
            my $e = pop( @AET );
            if ( %{$e}->{Ymax} != $y ) { push( @AET_copy, $e ); }
        }
        $y++;
        @AET = @AET_copy;
        
        for ( my $i=0; $i<$#AET+1; $i++ ) {
            if ( %{$AET[$i]}->{invSlope} != 0 ) {
                %{$AET[$i]}->{Xbot} += %{$AET[$i]}->{invSlope};
            }
        }
    } while( $#AET >= 0  and $#ET >= 0 );
}


sub calcOneOverSlope {
    my $e = shift;
    my $y = $e->{edge}->[0]->gety() - $e->{edge}->[1]->gety();
    my $x =    $e->{edge}->[0]->getx() - $e->{edge}->[1]->getx();
    if ( $y == 0 ) { return undef; }
    return $x/$y;
}

sub getHighestY {
    my $edges     = shift;

#print Dumper( $edges );
    my $highest = @{$edges}->[0]->{edge}->[0]->gety();

    for my $edge (@{$edges}) { 
        for my $vector (@{$edge->{edge}}) { 
            my $y = $vector->gety();
            if ( $y > $highest ) {
                $highest = $y;
            }
        }
    }
    return $highest;
}

sub setPixel {
    my ( $pkg, $X, $Y, $color ) = @_;
    my $rgb = sprintf "#%03x", $color;

    $pkg->{can}->create ( 'rectangle',
        $X,   $Y, 
        $X+1, $Y+1,
        -fill => $rgb,
        -outline => $rgb
    );
}

1;
}}

[Tanalis]

Clive maybe has a point, an error message would help a lot.

What I'd do in your situation is put a load of warn statements in such that you can track exactly where the script is and when, and what variables are set to at key points throughout the program.

If you think that the problem is with one of those three subs, then that's a good place to start. Ensure something's not getting overridden, that if..then..else and the like are working correctly.

If nothing else, that'll give you a whole load of debug data, and hopefully an elusive error, that'll help you narrow the problem down and come back with something a little clearer.

Hope that helps a little ..
--Foxcub

[cLive ;-)]

You post a gazillion lines of code and no error message. What are we, psychic?!!!

Come on, show a bit more effort. Strip your code down to a bare bones example that still fails and then post your question.

Yes, Perl programmers are supposed to be lazy^tm, but this is taking it a little too far :)

.02

cLive ;-)

[graff]

When I ran your code with perl 5.8, I got these warnings:

Using an array as a reference is deprecated at /tmp/3dgraphics.perl li
+ne 989.
Using an array as a reference is deprecated at /tmp/3dgraphics.perl li
+ne 990.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1004.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1004.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1004.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1064.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1064.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1076.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1077.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1081.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1082.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1087.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1091.
Using an array as a reference is deprecated at /tmp/3dgraphics.perl li
+ne 1092.
Using an array as a reference is deprecated at /tmp/3dgraphics.perl li
+ne 1094.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1101.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1107.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1108.
Using a hash as a reference is deprecated at /tmp/3dgraphics.perl line
+ 1108.
Using an array as a reference is deprecated at /tmp/3dgraphics.perl li
+ne 1127.

This stuff arises from lines like this (this is the code at line 1064):

        @AET = sort{ %{$a}->{Xbot} <=> %{$b}->{Xbot} } @AET;

Sure enough, you're using the "%" sigil on a value that is supposed to be treated as a scalar.

You should try to adjust the lines involved to see if you can avoid those warnings -- then see if the code behaves the same way. (There's a chance that the values you are manipulating are not what you're expecting them to be.)

update: forgot to mention: just because you're using Tk doesn't mean you can't use the perl debugger. Run the script with "perl -d" and put breakpoints at some of those lines that are setting and testing Z-buffer values; when the code gets to one of those lines, look at the values being tested or assigned. (And figure out if it's just something simple, like adding when you should be subtracting, or whatever.)

[rbc]

[graff]

Well, I still get the following set of warnings (maybe not the same ones, but at least fewer of them) -- and two of the lines you just quoted are among them:

Using an array as a reference is deprecated at /tmp/3dgraphics2.perl l
+ine 989.
Using an array as a reference is deprecated at /tmp/3dgraphics2.perl l
+ine 990.
Using an array as a reference is deprecated at /tmp/3dgraphics2.perl l
+ine 1094.
Using an array as a reference is deprecated at /tmp/3dgraphics2.perl l
+ine 1096.
Using an array as a reference is deprecated at /tmp/3dgraphics2.perl l
+ine 1129.

where this is offending expression at lines 1094 and 1096:

       @{$zbuffer}->[$x]->[$y]

I tried changing these two to be:

       $$zbuffer[$x][$y]

the code still ran and still did the wrong things, same as before. As for what you may be doing wrong in one or the other spot of code, I couldn't guess, but consider doing "perl -d yourscript" to run it with the debugger.

When you see the "DB<1>" prompt, type "b 251" -- that sets a breakpoint at the start of this expression:

       my $rec = {
                  edge => [$A, $B],
                  dx   => abs($X1 - $X2),
                  dz   => $Z1 - $Z2,
                  z    => ( $X1 < $X2 ) ? ($Z1) : ($Z2)
                  };

then type "c" to run the script till it reaches that break point. The GUI comes up, you can set parameters (I chose to set "rotX" of "40" instead of "0"), and hit the "Draw" button. Eventually the program will stop when it hits the chosen line, and you get the "DB" prompt back; see "perldebug" and "perldebtut" for fun things to try.

[Mr. Muskrat]

What is wrong with it?
I mean aside from how extremely slow it runs.

I don't do 3D graphics every day (or any day for that matter).
Explain what it is supposed to do and what it is doing. Then maybe we can help you.

[Anonymous Monk]

This node and its responses remind me of the old joke


• Answers $5
• Correct Answers $10
• Dumb looks are still free.
  
  Looks like you gotta a lot of dumb looks.
  You should post your question/code on google.