Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
go ahead... be a heretic
 
PerlMonks  

help with Z-buffer algorithm

by rbc (Curate)
on Nov 06, 2002 at 05:42 UTC ( #210664=perlquestion: print w/ replies, xml ) Need Help??
rbc has asked for the wisdom of the Perl Monks concerning the following question:

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; }}

Comment on help with Z-buffer algorithm
Download Code
Re: help with Z-buffer algorithm
by cLive ;-) (Parson) on Nov 06, 2002 at 08:50 UTC
    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 lazytm, but this is taking it a little too far :)

    .02

    cLive ;-)

Re: help with Z-buffer algorithm
by Tanalis (Curate) on Nov 06, 2002 at 09:26 UTC
    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

Re: help with Z-buffer algorithm
by Mr. Muskrat (Abbot) on Nov 06, 2002 at 18:06 UTC

    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.

Re: help with Z-buffer algorithm
by Anonymous Monk on Nov 06, 2002 at 22:37 UTC
    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.
Re: help with Z-buffer algorithm
by graff (Chancellor) on Nov 07, 2002 at 02:46 UTC
    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.)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://210664]
Approved by Tanalis
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (10)
As of 2014-04-17 09:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (443 votes), past polls