Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Pastel / BasicStroke.pm

package Pastel::BasicStroke;\r
@ISA = qw(Pastel::Mixin::Mixin);\r
use Carp;\r
use strict;\r
\r
sub new {\r
    my $class = shift;\r
    my $self = {};\r
    bless $self, ref($class) || $class;\r
    $self->_init(@_);\r
    return $self;\r
}\r
\r
sub _init {\r
     my ($self, @args) = @_;\r
     my ($width,$cap,$join,$miterlimit,$dasharray,$dashoffset)\r
        =$self->_rearrange(["WIDTH","CAP","JOIN",\r
                             "MITER","DASHARRAY","DASHOFFSET"],@args);\r
     $self->{width} = defined($width)? $width :1; # Default width = 1\r
     if(defined($cap)){\r
         if($cap =~/BUTT/i){\r
                 $self->{cap} = "butt";\r
         }\r
         elsif($cap =~/ROUND/i){\r
                  $self->{cap} = "round";\r
         }\r
         elsif($cap =~/SQUARE/i){\r
                    $self->{cap} ="square";\r
         }\r
         else { croak "Illegal parameter of Line-cap\n";}\r
      }\r
      else{\r
          # $self->{cap} = "square";\r
	  $self->{cap} = undef;\r
}\r
      if(defined($join)){\r
          if($join =~ /ROUND/i){\r
                   $self->{join} ="round";\r
          }\r
          elsif($join =~/BEVEL/i){\r
                   $self->{join} ="bevel";\r
          }\r
          elsif($join =~/MITER/i){\r
                   $self->{join} ="miter"\r
          }\r
          else {croak "Illegal paramter of Line join\n";\r
          }\r
       }\r
       else{\r
            #$self->{join} ="miter";\r
       $self->{join} = undef;\r
       }\r
       \r
       $self->{miterlimit} = defined($miterlimit)? $miterlimit: undef; #10;\r
       $self->{dasharray} = defined($dasharray)?$dasharray : undef;   \r
       $self->{dashoffset} = defined($dashoffset) ? $dashoffset : undef;\r
       return $self;\r
  }\r
  \r
 sub equals {\r
      my ($self) = shift;\r
      \r
      if (ref($_[0]) ne ref($self)){\r
         carp "Error: Not a basicstroke object!\n";\r
         return 0;\r
      }\r
      \r
      if ( ($self->{width} ne $_[0]->{width}) ||\r
                 ($self->{cap}   ne $_[0]->{cap}  ) ||\r
                 ($self->{join}  ne $_[0]->{join} ) ||\r
                 ($self->{miterlimit} ne $_[0]->{miterlimit}) #||\r
                 #($self->{dasharray} ne $_[0]->{dasharray}) ||\r
                 #($self->{dashoffset} ne $_[0]->{dashoffset})\r
                ){\r
                  return 0;\r
      }\r
\r
      if (defined($self->{dasharray}) != defined($_[0]->{dasharray})){\r
          return 0;\r
      }\r
      if (defined ($self->{dasharray}) ){\r
        # print "**************Checkdasharray caller**************\n";\r
          return 0 unless defined ($_[0]->{dasharray});\r
         # print "Step1\n";\r
          #return 0 unless (@{$self->{dasharray}} != @{$_[0]->{dasharray}});\r
         #  print "Step2\n";\r
          return 0 unless $self->_checkdasharray($self->{dasharray}, $_[0]->{dasharray});\r
      }\r
                       \r
      if (defined($self->{dashoffset} ) != defined($_[0]->{dashoffset})){\r
         return 0;\r
      }\r
      if (defined($self->{dashoffset})){    \r
          return 0 unless defined($_[0]->{dashoffset});\r
          return 0 unless ($self->{dashoffset} ne $_[0]->{dashoffset});\r
      }             \r
     \r
     else {return 1;}\r
\r
}\r
\r
sub get_dash_array {\r
    if ( defined( $_[0]->{dasharray} ) ){\r
       my @array = @{$_[0]->{dasharray}};\r
       \r
       my $s="";\r
       for (my $i=0; $i<@array; $i++){\r
	 $s .= $array[$i];\r
	 $s .= " ";\r
	 }\r
       return $s;\r
	 \r
       \r
    }\r
    else {\r
         return undef;\r
    }\r
}\r
\r
sub get_dashoffset {\r
    if ( defined( $_[0]->{dashoffset} ) ){\r
       return $_[0]->{dashoffset};\r
    }\r
    else {\r
         return undef;\r
    }\r
} \r
\r
sub get_end_cap { $_[0]->{cap}; }\r
sub get_line_join {$_[0]->{join}; }\r
sub get_line_width {$_[0]->{width}; }\r
sub get_miter_limit {$_[0]->{miterlimit}; }\r
\r
# To be done\r
\r
sub create_stroked_shape {\r
  my $self = shift;\r
  my $shape = shift;\r
  $shape->set_stroke($self);\r
  return $shape;\r
}\r
###############\r
    \r
sub _checkdasharray {\r
    #print "************CHEKDASHARRAY***************\n";\r
    my ($self, @args) = @_;\r
    my @array1 = @{ $args[0] };\r
    my @array2 = @{ $args[1] };\r
    #print @array1, ",", @array2, "\n";\r
    if (@array1 != @array2){\r
        #print "************Inside compare***************\n";\r
       return 0;\r
    }\r
    else {\r
         # print "************Inside else***************\n";\r
         for ( my $i = 0 ; $i < @array1; $i++ ){\r
             # print "************Inside loop***************\n";\r
             return 0 if $array1[$i] ne $array2[$i];\r
             #print "never entered\n";\r
          }\r
    }\r
    return 1;\r
}\r
\r
\r
sub to_svg  {\r
  my $self = shift;\r
  my $s = "";\r
  if(defined($self->{width} )){\r
   $s .= qq(stroke-width:$self->{width});\r
  #$s .= ';';\r
}\r
  my $dasharray = $self->get_dash_array();\r
  my $dashoffset = $self->get_dashoffset();\r
  \r
  if (defined($self->{cap}) && ($self->{cap} ne "butt")){\r
    $s .= ";"."stroke-linecap:".$self->{cap};\r
  }\r
  if (defined($self->{join}) && ($self->{join} ne "miter")){\r
	$s .= ";"."stroke-linejoin:".$self->{join};\r
      }\r
  if (defined($self->{miterlimit}) && ($self->{miterlimit} != 4)){\r
    $s .= ";stroke-miterlimit:".$self->{miterlimit};\r
  }\r
  if (defined ($self->{dasharray})){\r
    $s .= ";stroke-dasharray:".$dasharray.";";\r
  }\r
  if (defined ($self->{dashoffset})){\r
    $s .= ";stroke-dashoffset:".$dashoffset;\r
  }\r
  return $s;\r
}\r
  \r
    \r
1;\r