diff options
author | Karl Berry <karl@freefriends.org> | 2012-04-13 23:09:10 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2012-04-13 23:09:10 +0000 |
commit | 2d9b64e84ae06eba8f2f5d0e958f4f2f335de076 (patch) | |
tree | e49120eb2857c9aa1a11ca26cda4d3ba5db6b8b6 /Master/texmf-dist/scripts/pedigree-perl/Pedigree/TwinsNode.pm | |
parent | 1c08c44c738be3e43fc4411812e7484d2471de7e (diff) |
new pstricks+script pedigree-perl (16mar12)
git-svn-id: svn://tug.org/texlive/trunk@25962 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/pedigree-perl/Pedigree/TwinsNode.pm')
-rw-r--r-- | Master/texmf-dist/scripts/pedigree-perl/Pedigree/TwinsNode.pm | 172 |
1 files changed, 172 insertions, 0 deletions
diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/TwinsNode.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/TwinsNode.pm new file mode 100644 index 00000000000..c8557230bd7 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/TwinsNode.pm @@ -0,0 +1,172 @@ +=pod + +=head1 NAME + +Pedigree::TwinsNode - an auxillary twins node in a pedigree + +=head1 SYNOPSIS + +use Pedigree::TwinsNode; + +$node = new Pedigree::TwinsNode(I<%params>); + + +$node->DrawNode(I<$xidst>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +$node->DrawConnections(); + + +=head1 DESCRIPTION + +This package contains data about a twins node. Twins node is +a special node between the parent and the twins. + +=over 4 + +=cut + + + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::TwinsNode; +use Pedigree; +use strict; +our @ISA=('Pedigree::Node'); + + +#################################################################### +# new # +#################################################################### + +=pod + +=item B<new>(I<%params>); + +Construct a new node from the given parameters. + +=cut + +sub new { + my ($class,%params)=@_; + my $self=$class->SUPER::new(%params); + if (!ref($self)) { # Bad node + return 0; + } + + bless ($self,$class); + + # After we constructed the node, we want to move the kids + # from the parent node to the twins node + + my $selfId = $self->{'Id'}; + my $parentId = $self->{'ParentId'}; + foreach my $kidId (keys %{$self->{'KidIds'}}) { + if ($main::DEBUG) { + print STDERR + "Moving $kidId from $parentId and to $selfId\n"; + } + delete $self->{'kids_by_parent_id'}->{$parentId}->{$kidId}; + $self->{'kids_by_parent_id'}->{$selfId}->{$kidId}=1; + } + + return $self; +} + + + +#################################################################### +# DrawNode # +#################################################################### + +=pod + +=item B<DrawNode>(I<$xdist>, I<$ydist>, I<$belowtextfont>, I<$abovetextfont>, +I<@fieldsfornode>); + +Output the command to draw this node. The parameters are +distances between the nodes (in psunits). + +=cut + +sub DrawNode { + my $self=shift; + my ($xdist, $ydist, $belowtextfont, $abovetextfont, @fieldsfornode) = @_; + my $result = '\rput('.($xdist*$self->GetAbsX()).", ". + ($ydist*$self->GetAbsY()).'){\pnode{'. + $self->Id()."}}\n"; + return $result; +} + +#################################################################### +# DrawConnections # +#################################################################### + +=pod + +=item B<DrawConnections>(); + +Draw the connections from the given node to its descendants and +the parent + +=cut + +sub DrawConnections { + my $self = shift; + my $xdist = shift; + my $ydist = shift; + my $Id=$self->Id(); + my $parentId = $self->{'ParentId'}; + my @kids = @{$self->Kids()}; + my $leftKid=shift @kids; + my $leftKidId=$leftKid->Id(); + my $rightKid= pop @kids; + my $rightKidId=$rightKid->Id(); + my @opts; + if ($self->Type()) { + push @opts, $self->Type(); + } + foreach my $kid (@kids) { + push @opts, "addtwin=".$kid->Id(); + } + my $result = '\pstTwins['; + if (scalar @opts) { + $result .= join (", ",@opts); + } + $result .= ']{'.$parentId.'}{'. + $Id.'}{'.$leftKidId.'}{'.$rightKidId.'}'."\n"; + return $result; +} + + + + +#################################################################### +# THE END # +#################################################################### + +=pod + +=back + +=head1 ENVIRONMENT + +The calling program should define B<$main::DEBUG> and set it to 0 +or 1. + +=head1 SEE ALSO + +pedigree(1), Pedigree(3) + +=head1 AUTHOR + +Boris Veytsman, Leila Akhmadeeva, 2007 + + + +=cut + +1; |