view release on metacpan or  search on metacpan

lib/Math/Zap/Draw.pm  view on Meta::CPAN

have large Perl computers.

The key advantage of this package is that is open: you can manipulate
both the objects to be drawn and the drawing itself all in Pure Perl.

=cut


package Math::Zap::Draw;
$VERSION=1.07;
use Math::Zap::Vector check=>'vectorCheck';
use Math::Zap::Vector2;
use Math::Zap::Triangle2  newnnc=>'triangle2Newnnc';
use Math::Zap::Triangle;
use Math::Zap::Color;
use Tk;
use Carp;

use constant debug=>0;


=head2 Constructors


=head3 draw

Constructor

=cut


sub draw() {bless {}}


=head2 Methods


=head3 from 

Set view point 

=cut


sub from($$)
 {my ($d) =         check(@_[0..0]); # Drawing 
  my ($v) = vectorCheck(@_[1..1]); # Vector

  $d->{from} = $v;
  $d;
 }


=head3 to

Viewing this point

=cut


sub to($$)
 {my ($d) =         check(@_[0..0]); # Drawing 
  my ($v) = vectorCheck(@_[1..1]); # Vector

  $d->{to} = $v;
  $d;
 }


=head3 Horizon

Sets the direction of the horizon.

=cut


sub horizon($$)
 {my ($d) =         check(@_[0..0]); # Drawing 
  my ($v) = vectorCheck(@_[1..1]); # Vector

  $d->{horizon} = $v;
  $d;
 }


=head3 light

Light source position

=cut


sub light($$)
 {my ($d) =         check(@_[0..0]); # Drawing 
  my ($v) = vectorCheck(@_[1..1]); # Vector

  $d->{light} = $v;
  $d;
 }


=head3 withControls

Display a window allowing the user to set to,from,horizon,light

=cut


sub withControls($)
 {my ($d) =         check(@_[0..0]); # Drawing 

  $d->{withControls} = 1;
  $d;
 }

=head3 object

Draw this object

=cut

lib/Math/Zap/Draw.pm  view on Meta::CPAN

  &new($d);
 }


=head2 Methods


=head3 print

Print the complete object list as a triangles in a reusable manner.

=cut


sub print($)
 {my ($d) = check(@_[0..0]); # Drawing
  my $l = << 'END';
#!perl -w
use Math::Zap::Draw;
use Math::Zap::Triangle;
use Math::Zap::Vector;

draw
END
  $l .= '->from    ('. $d->{from}   ->print .")\n";
  $l .= '->to      ('. $d->{to}     ->print .")\n";
  $l .= '->horizon ('. $d->{horizon}->print .")\n";
  $l .= '->light   ('. $d->{light}  ->print .")\n";

  for my $p(@{$d->{triangles}}) # Triangulation
   {$l .= '  ->object('. $p->{triangle}->print .', \''. $p->{color}. "\')\n";
   }
  $l .= "->done;\n";
 }


=head3 check

Check its a drawing 

=cut


sub check(@)
 {if (debug)
   {for my $t(@_)
     {confess "$t is not a drawing" unless ref($t) eq __PACKAGE__;
     }
   } 
  return (@_)
 }


=head3 is

Test its a drawing 

=cut


sub is(@)
 {for my $t(@_)
   {return 0 unless ref($t) eq __PACKAGE__;
   }
  'draw';
 }


=head3 showFissionFragments

Show fission fragments: the objects to be drawn are triangulated
where-ever they may intersect.  It is useful to see these sub triangles
when debugging.  See also L</fission>.

=cut


sub showFissionFragments($)
 {my ($d) =         check(@_[0..0]); # Drawing 

  $d->{showFissionFragments} = 1;
  $d;
 }


=head3 Fission

Fission the triangles that intersect.  See L</showFissionFragments>

=cut


sub fission($)
 {my ($d) = check(@_[0..0]);    # Drawing 
  my @P   = @{$d->{triangles}}; # Triangles to be fissoned
  my $tested;                   # Source triangles already tested

#_ Draw ________________________________________________________________
# Check each pair of triangles
#_______________________________________________________________________

  L: for(;;)
   {for   (my $i = 0; $i < scalar(@P); ++$i)
     {my $p = $P[$i];
      next unless defined($p);

#_ Draw ________________________________________________________________
# Check against triangle 
#_______________________________________________________________________

      for (my $j = $i+1; $j < scalar(@P); ++$j)
       {my $q = $P[$j];
        next unless defined($q);
        my ($t, @t, @T);

#_ Draw ________________________________________________________________
# Already tested
#_______________________________________________________________________

        next if $tested->{$p->{plane}}{$q->{plane}};
        $tested->{$p->{plane}}{$q->{plane}} = 1;