Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / SVG / Element.pm

=pod 

=head1 NAME

SVG::Element - Generate the element bits for SVG.pm

=head1 AUTHOR

Ronan Oger, ronan@roasp.com

=head1 SEE ALSO

perl(1),L<SVG>,L<SVG::XML>,L<SVG::Element>,L<SVG::Parser>, L<SVG::Manual>
http://www.roasp.com/
http://www.perlsvg.com/
http://www.roitsystems.com/
http://www.w3c.org/Graphics/SVG/

=cut

package SVG::Element;

$VERSION = "2.26";

use strict;
use SVG::XML;
use SVG::DOM;
use SVG::Extension;
use vars qw($AUTOLOAD %autosubs);

my @autosubs=qw(
    animateMotion animateColor animateTransform circle ellipse rect polyline 
    path polygon line title desc defs
    altGlyph altGlyphDef altGlyphItem clipPath color-profile
    cursor definition-src font-face-format font-face-name
    font-face-src font-face-url foreignObject glyph
    glyphRef hkern marker mask metadata missing-glyph
    mpath switch symbol textPath tref tspan view vkern marker textbox
    flowText style
);

%autosubs=map { $_ => 1 } @autosubs;

#-------------------------------------------------------------------------------

sub new ($$;@) {
    my ($proto,$name,%attrs)=@_;
    my $class=ref($proto) || $proto;
    my $self={-name => $name};
    foreach my $key (keys %attrs) {
        next if $key=~/^\-/;
        $self->{$key}=$attrs{$key};
    }

    return bless($self,$class);
}

#-------------------------------------------------------------------------------

sub release ($) {
    my $self=shift;

    foreach my $key (keys(%{$self})) {
        next if $key=~/^\-/;
        if (ref($self->{$key})=~/^SVG/) {
            eval { $self->{$key}->release; };
        }
        delete($self->{$key});
    }

    return $self;
}

sub xmlify ($) {
    my $self = shift;
    my $ns = $self->{-namespace} || $self->{-docref}->{-namespace} || undef;
    my $xml = '';
    #prep the attributes
    my %attrs;
    foreach my $k (keys(%{$self})) {
        if($k=~/^\-/) { next; }
        if(ref($self->{$k}) eq 'ARRAY') {
            $attrs{$k}=join(', ',@{$self->{$k}});
        } elsif(ref($self->{$k}) eq 'HASH') {
            $attrs{$k}=cssstyle(%{$self->{$k}});
        } elsif(ref($self->{$k}) eq '') {
            $attrs{$k}=$self->{$k};
        }
    }
    #prep the tag
    if($self->{-comment}) {
        $xml .= $self->xmlcomment($self->{-comment});
        return $xml;
    } elsif($self->{-pi}) {
        $xml .= $self->xmlpi($self->{-pi});
        return $xml;
    } elsif ($self->{-name} eq 'document') {
        #write the xml header
        $xml .= $self->xmldecl;
        #and write the dtd if this is inline
        $xml .= $self->dtddecl unless $self->{-inline};
        foreach my $k (@{$self->{-childs}}) {
            if(ref($k)=~/^SVG::Element/) {
                $xml .= $k->xmlify($ns);
            }
        }
        return $xml;
    } 
    if(defined $self->{-childs} ||
        defined $self->{-cdata} ||
        defined $self->{-CDATA} ||
        defined $self->{-cdata_noxmlesc}) {
        $xml .= $self->{-docref}->{-elsep};
        $xml .= $self->{-docref}->{-indent} x $self->{-docref}->{-level};
        $xml .= xmltagopen_ln($self->{-name},$ns,%attrs);
        $self->{-docref}->{-level}++;
        foreach my $k (@{$self->{-childs}}) {
            if(ref($k)=~/^SVG::Element/) {
                $xml .= $k->xmlify($ns);
            }
        }

        if(defined $self->{-cdata}) {
            $xml .= xmlescp($self->{-cdata});
        } 
        if(defined $self->{-CDATA}) {
            $xml .= '<![CDATA['.$self->{-CDATA}.']]>';
        }
        if(defined $self->{-cdata_noxmlesc}) {
            $xml .= $self->{-cdata_noxmlesc};
        }


        #return without writing the tag out if it the document tag
        $self->{-docref}->{-level}--;
        $xml .= $self->{-docref}->{-elsep};
        $xml .= $self->{-docref}->{-indent} x $self->{-docref}->{-level};
        $xml .= xmltagclose_ln($self->{-name},$ns);
    } else {
        $xml .= $self->{-docref}->{-elsep};
        $xml .= $self->{-docref}->{-indent} x $self->{-docref}->{-level};
        $xml .= xmltag_ln($self->{-name},$ns,%attrs);
    }
    #return the finished tag
    return $xml;
}

sub perlify {
    my $self=shift;
    my $code='';

    #prep the attributes
    my %attrs;
    foreach my $k (keys(%{$self})) {
        if($k=~/^\-/) { next; }
        if(ref($self->{$k}) eq 'ARRAY') {
            $attrs{$k}=join(', ',@{$self->{$k}});
        } elsif(ref($self->{$k}) eq 'HASH') {
            $attrs{$k}=cssstyle(%{$self->{$k}});
        } elsif(ref($self->{$k}) eq '') {
            $attrs{$k}=$self->{$k};
        }
    }

    if($self->{-comment}) {
        $code .= "->comment($self->{-comment})";
        return $code;
    } elsif($self->{-pi}) {
        $code .= "->pi($self->{-pi})";
        return $code;
    } elsif ($self->{-name} eq 'document') {
        #write the xml header
        #$xml .= $self->xmldecl;
        #and write the dtd if this is inline
        #$xml .= $self->dtddecl unless $self->{-inline};
        foreach my $k (@{$self->{-childs}}) {
            if(ref($k)=~/^SVG::Element/) {
                $code .= $k->perlify();
            }
        }
        return $code;
    }

    if (defined $self->{-childs}) {
        $code .= $self->{-docref}->{-elsep};
        $code .= $self->{-docref}->{-indent} x $self->{-docref}->{-level};
        $code .= $self->{-name}.'('.(join ', ',(map { "$_=>'$attrs{$_}'"} sort keys %attrs)).')';
        if ($self->{-cdata}) {
            $code.="->cdata($self->{-cdata})";
        } elsif ($self->{-CDATA}) {
            $code.="->CDATA($self->{-CDATA})";
        } elsif ($self->{-cdata_noxmlesc}) {
            $code.="->cdata_noxmlesc($self->{-cdata_noxmlesc})";
        }

        $self->{-docref}->{-level}++;
        foreach my $k (@{$self->{-childs}}) {
            if(ref($k)=~/^SVG::Element/) {
                $code .= $k->perlify();
            }
        }
        $self->{-docref}->{-level}--;
    } else {
        $code .= $self->{-docref}->{-elsep};
        $code .= $self->{-docref}->{-indent} x $self->{-docref}->{-level};
        $code .= $self->{-name}.'('.(join ', ',(map { "$_=>'$attrs{$_}'"} sort keys %attrs)).')';
    }

    return $code;
}
*toperl=\&perlify;


sub addchilds ($@) {
    my $self=shift;
    push @{$self->{-childs}},@_;
    return $self;
}

=pod

=head2 tag (alias: element)
 
$tag = $SVG->tag($name, %attributes)

Generic element generator. Creates the element named $name with the attributes
specified in %attributes. This method is the basis of most of the explicit
element generators.

B<Example:>

    my $tag = $SVG->tag('g', transform=>'rotate(-45)');

=cut

sub tag ($$;@) {
    my ($self,$name,%attrs)=@_;

    unless ($self->{-parent}) {
      #traverse down the tree until you find a non-document entry
      while ($self->{-document})  {$self = $self->{-document}}
    }
    my $tag=new SVG::Element($name,%attrs);

    #define the element namespace
    $tag->{-namespace}=$attrs{-namespace} if ($attrs{-namespace});

    #add the tag to the document element
    $tag->{-docref} = $self->{-docref};
    
    #create the empty idlist hash ref unless it already exists
    $tag->{-docref}->{-idlist} = {} 
        unless (defined $tag->{-docref}->{-idlist});
    
    #verify that the current id is unique. compain on exception
    #>>>TBD: add -strictids option to disable this check if desired
    if ($tag->{id}) {
        if ($self->getElementByID($tag->{id})) {
            $self->error($tag->{id} => "ID already exists in document");
            return undef;
        }
    }

    #add the current id reference to the document id hash
    $tag->{-docref}->{-idlist}->{$tag->{id}} = $tag if defined ($tag->{id});
    
    #create the empty idlist hash ref unless it already exists
    $tag->{-docref}->{-elist} = {} 
        unless (defined $tag->{-docref}->{-elist});
    
    #create the empty idlist hash ref unless it already exists
    $tag->{-docref}->{-elist}->{$tag->{-name}} = [] 
        unless (defined $tag->{-docref}->{-elist}->{$tag->{-name}});

    #add the current element ref to the corresponding element-hash array
    # -elist is a hash of element names. key name is element, content is object ref.

    # add the reference to $tag to the array of refs that belong to the
    # key $tag->{-name}.
    unshift    @{$tag->{-docref}->{-elist}->{$tag->{-name}}},$tag;

        # attach element to the DOM of the document
    $tag->{-parent}=$self;
    $tag->{-parentname}=$self->{-name};
    $self->addchilds($tag);

    return($tag);
}

*element=\&tag;

=pod

=head2 anchor

$tag = $SVG->anchor(%attributes)

Generate an anchor element. Anchors are put around objects to make them
'live' (i.e. clickable). It therefore requires a drawn object or group element
as a child.

B<Example:>

    # generate an anchor    
    $tag = $SVG->anchor(
        -href=>'http://here.com/some/simpler/SVG.SVG'
    );
    # add a circle to the anchor. The circle can be clicked on.
    $tag->circle(cx=>10,cy=>10,r=>1);

    # more complex anchor with both URL and target
    $tag = $SVG->anchor(
          -href   => 'http://somewhere.org/some/other/page.html',
          -target => 'new_window'
    );

=cut

sub anchor {
    my ($self,%attrs)=@_;
    my $an=$self->tag('a',%attrs);
    $an->{'xlink:href'}=$attrs{-href} if(defined $attrs{-href});
    $an->{'target'}=$attrs{-target} if(defined $attrs{-target});
    return($an);
}

sub svg {
    my ($self,%attrs)=@_;
    my $svg=$self->tag('svg',%attrs);
    $svg->{'height'} = '100%' unless ($svg->{'height'});
    $svg->{'width'}  = '100%' unless ($svg->{'width'});
    return($svg);
}

=pod

=head2 circle

$tag = $SVG->circle(%attributes)

Draw a circle at (cx,cy) with radius r.

B<Example:>

    my $tag = $SVG->circlecx=>4, cy=>2, r=>1);

=cut

=pod

=head2 ellipse

$tag = $SVG->ellipse(%attributes)

Draw an ellipse at (cx,cy) with radii rx,ry.

B<Example:>

    my $tag = $SVG->ellipse(
        cx=>10, cy=>10,
        rx=>5, ry=>7,
        id=>'ellipse',
        style=>{
            'stroke'=>'red',
            'fill'=>'green',
            'stroke-width'=>'4',
            'stroke-opacity'=>'0.5',
            'fill-opacity'=>'0.2'
        }
    );

=cut

=pod

=head2 rectangle (alias: rect)

$tag = $SVG->rectangle(%attributes)

Draw a rectangle at (x,y) with width 'width' and height 'height' and side radii
'rx' and 'ry'.

B<Example:>

    $tag = $SVG->rectangle(
        x=>10, y=>20,
        width=>4, height=>5,
        rx=>5.2, ry=>2.4,
        id=>'rect_1'
    );

=cut

sub rectangle ($;@) {
    my ($self,%attrs)=@_;
        return $self->tag('rect',%attrs);
}

=pod

=head2 image

 $tag = $SVG->image(%attributes)

Draw an image at (x,y) with width 'width' and height 'height' linked to image
resource '-href'. See also L<"use">.

B<Example:>

    $tag = $SVG->image(
        x=>100, y=>100,
        width=>300, height=>200,
        '-href'=>"image.png", #may also embed SVG, e.g. "image.SVG"
        id=>'image_1'
    );

B<Output:>

    <image xlink:href="image.png" x="100" y="100" width="300" height="200"/>

=cut

sub image ($;@) {
    my ($self,%attrs)=@_;
    my $im=$self->tag('image',%attrs);
    $im->{'xlink:href'}=$attrs{-href} if(defined $attrs{-href});
    return $im;
}

=pod

=head2 use

$tag = $SVG->use(%attributes)

Retrieve the content from an entity within an SVG document and apply it at
(x,y) with width 'width' and height 'height' linked to image resource '-href'.

B<Example:>

    $tag = $SVG->use(
        x=>100, y=>100,
        width=>300, height=>200,
        '-href'=>"pic.SVG#image_1",
        id=>'image_1'
    );

B<Output:>

    <use xlink:href="pic.SVG#image_1" x="100" y="100" width="300" height="200"/>

According to the SVG specification, the 'use' element in SVG can point to a
single element within an external SVG file.

=cut

sub use ($;@) {
    my ($self,%attrs)=@_;
    my $u=$self->tag('use',%attrs);
    $u->{'xlink:href'}=$attrs{-href} if(defined $attrs{-href});
    return $u;
}

=pod

=head2 polygon

$tag = $SVG->polygon(%attributes)

Draw an n-sided polygon with vertices at points defined by a string of the form
'x1,y1,x2,y2,x3,y3,... xy,yn'. The L<"get_path"> method is provided as a
convenience to generate a suitable string from coordinate data.

B<Example:>

    # a five-sided polygon
    my $xv = [0,2,4,5,1];
    my $yv = [0,0,2,7,5];

    $points = $a->get_path(
        x=>$xv, y=>$yv,
        -type=>'polygon'
    );

    $c = $a->polygon(
        %$points,
        id=>'pgon1',
        style=>\%polygon_style
    );

SEE ALSO:

L<"polyline">, L<"path">, L<"get_path">.

=cut

=pod

=head2 polyline

$tag = $SVG->polyline(%attributes)

Draw an n-point polyline with points defined by a string of the form
'x1,y1,x2,y2,x3,y3,... xy,yn'. The L<"get_path"> method is provided as a
convenience to generate a suitable string from coordinate data.

B<Example:>

    # a 10-pointsaw-tooth pattern
    my $xv = [0,1,2,3,4,5,6,7,8,9];
    my $yv = [0,1,0,1,0,1,0,1,0,1];

    $points = $a->get_path(
        x=>$xv, y=>$yv,
        -type=>'polyline',
        -closed=>'true' #specify that the polyline is closed.
    );

    my $tag = $a->polyline (
        %$points,
        id=>'pline_1',
        style=>{
            'fill-opacity'=>0,
            'stroke-color'=>'rgb(250,123,23)'
        }
    );

=head2 line

$tag = $SVG->line(%attributes)

Draw a straight line between two points (x1,y1) and (x2,y2).

B<Example:>

    my $tag = $SVG->line(
        id=>'l1',
        x1=>0, y1=>10,
        x2=>10, y2=>0
    );

To draw multiple connected lines, use L<"polyline">.

=head2 text

$text = $SVG->text(%attributes)->cdata();

$text_path = $SVG->text(-type=>'path');
$text_span = $text_path->text(-type=>'span')->cdata('A');
$text_span = $text_path->text(-type=>'span')->cdata('B');
$text_span = $text_path->text(-type=>'span')->cdata('C');


define the container for a text string to be drawn in the image.

B<Input:> 
    -type     = path type (path | polyline | polygon)
    -type     = text element type  (path | span | normal [default])

B<Example:>

    my $text1 = $SVG->text(
        id=>'l1', x=>10, y=>10
    )->cdata('hello, world');

    my $text2 = $SVG->text(
        id=>'l1', x=>10, y=>10, -cdata=>'hello, world');

    my $text = $SVG->text(
        id=>'tp', x=>10, y=>10 -type=>path)
        ->text(id=>'ts' -type=>'span')
        ->cdata('hello, world');

SEE ALSO:

    L<"desc">, L<"cdata">.

=cut

sub text ($;@) {
    my ($self,%attrs)=@_;
    my $pre = '';
    $pre = $attrs{-type} || 'std';
    my %get_pre = (std=>'text',
                   path=>'textPath',
                   span=>'tspan',);

    $pre = $get_pre{lc($pre)};
    my $text=$self->tag($pre,%attrs);
    $text->{'xlink:href'} = $attrs{-href} if(defined $attrs{-href});
       $text->{'target'} = $attrs{-target} if(defined $attrs{-target});
    return($text);
}

=pod

=head2 title

$tag = $SVG->title(%attributes)

Generate the title of the image.

B<Example:>

    my $tag = $SVG->title(id=>'document-title')->cdata('This is the title');

=cut

=pod

=head2 desc

$tag = $SVG->desc(%attributes)

Generate the description of the image.

B<Example:>

    my $tag = $SVG->desc(id=>'document-desc')->cdata('This is a description');

=head2 comment

$tag = $SVG->comment(@comments)

Generate the description of the image.

B<Example:>

    my $tag = $SVG->comment('comment 1','comment 2','comment 3');

=cut

sub comment ($;@) {
    my ($self,@text)=@_;
    my $tag = $self->tag('comment');
    $tag->{-comment} = [@text];
    return $tag;
}

=pod 

$tag = $SVG->pi(@pi)

Generate a set of processing instructions

B<Example:>

    my $tag = $SVG->pi('instruction one','instruction two','instruction three');

    returns: 
      <lt>?instruction one?<gt>
      <lt>?instruction two?<gt>
      <lt>?instruction three?<gt>

=cut


sub pi ($;@) {
    my ($self,@text)=@_;
    my $tag = $self->tag('pi');
    $tag->{-pi} = [@text];
    return $tag;
}

=pod

=head2 script

$tag = $SVG->script(%attributes)

Generate a script container for dynamic (client-side) scripting using
ECMAscript, Javascript or other compatible scripting language.

B<Example:>

    my $tag = $SVG->script(-type=>"text/ecmascript");

    # populate the script tag with cdata
    # be careful to manage the javascript line ends.