perlquestion 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 <readmore> <code> #!/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, -background=>$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, compute 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, compute 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 of 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; }} </code>