view release on metacpan or  search on metacpan

lib/CSS/DOM/Value/Primitive.pm  view on Meta::CPAN

$unit_suffixes[CSS_PX         ] = 'px';
$unit_suffixes[CSS_CM         ] = 'cm';
$unit_suffixes[CSS_MM         ] = 'mm';
$unit_suffixes[CSS_IN         ] = 'in';
$unit_suffixes[CSS_PT         ] = 'pt';
$unit_suffixes[CSS_PC         ] = 'pc';
$unit_suffixes[CSS_DEG        ] = 'deg';
$unit_suffixes[CSS_RAD        ] = 'rad';
$unit_suffixes[CSS_GRAD       ] = 'grad';
$unit_suffixes[CSS_MS         ] = 'ms';
$unit_suffixes[CSS_S          ] = 's';
$unit_suffixes[CSS_HZ         ] = 'Hz';
$unit_suffixes[CSS_KHZ        ] = 'kHz';

sub cssText { 
	my $self = shift;
	my $old;
	if(defined wantarray) {
		if(defined $self->[csst]) {
			$old = $self->[csst]
		}
		else { for($self->[type]) {
			my $val = $self->[valu];
			$old
			 = $_ == CSS_RECT 
			    ? 'rect('
			     .  join(
			         ', ',
			          map $self->$_->cssText,
			           <top right bottom left>
			        )
			     .')'
			 : $_ == CSS_RGBCOLOR
			    ? ref $val eq 'ARRAY'
			       ? do {
			          my(@val_objs,$ret)
			           = map $self->$_, <red green blue>;
			          if(
			           my $form = $$self[sfrm]
				    and
			           @$val < 4 || $$val[3]->getFloatValue==1
			          ){
			           if($form =~ /^#/) {
			            # Try to preserve original #bed/#c0ffee
			            # format if possible
			            my $digits = chop $form;
			            if($digits == 1) {
			             for my $val_obj(@val_objs) {
			              my $val = $val_obj->getFloatValue;
			              if(
			               $val_obj->primitiveType
			                == CSS_NUMBER
			              ){
			               not $val % 17 and $val == int $val
			                and $val > 0 and $val < 256
			             # ~~~ Would it be faster simply to use
			             #     a regexp?
			                 or undef $ret, last;
			               $ret .= sprintf "%x", $val/17;
			              }
			              else { # percentage
			               not $val % 20 and $val == int $val
			                and $val > 0 and $val < 101
			             # ~~~ Would it be faster simply to use
			             #     a regexp?
			                 or undef $ret, last;
			               $ret .= sprintf "%x", $val * .15;
			              }
			             }
			            }
			            if(!$val || $digits == 2) {
			             for my $val_obj(@val_objs) {
			              my $val = $val_obj->getFloatValue;
			              if(
			               $val_obj->primitiveType
			                == CSS_NUMBER
			              ){
			               $val == int $val
			                and $val > 0 and $val < 256
			                 or undef $ret, last;
			               $ret .= sprintf "%02x", $val;
			              }
			              elsif($digits == 2) { # percentage
			               not $val % 20 and $val == int $val
			                and $val > 0 and $val < 101
			             # ~~~ Would it be faster simply to use
			             #     a regexp?
			                 or undef $ret, last;
			               $ret .= sprintf "%02x",$val * 2.55;
			              }
			             }
			            }
			            $ret and substr $ret,0,0, = '#';
			           }
			           else { # named colour
			            my $rgb = (\our %Colours)->{lc $form};
			            $val_objs[0]->getFloatValue
			             == $$rgb[0]
			            and $val_objs[1]->getFloatValue
			             == $$rgb[1]
			            and $val_objs[2]->getFloatValue
			             == $$rgb[2]
			            and $ret = $form;
			           }
			          }
			          
			          unless($ret) {
			           my @types
			            = map $_->primitiveType, @val_objs;
			           if($types[0] == $types[1]
			           && $types[0] == $types[2]) {
			            $ret = join ", ",
			                         map cssText $_, @val_objs;
			           }
			           else {
			            my $type = $types[
			              $types[0] == $types[1]
			               || $types[0] == $types[2]
			              ? 0
			              : 1
			            ];
			            $ret = join ", ", $type == CSS_NUMBER
			             ? map
			                $types[$_] == CSS_NUMBER
			                 ? $val_objs[$_]->getFloatValue
			                 : $val_objs[$_]->getFloatValue
			                    * 255/100,
			                0...2
			             : map
			                $types[$_] == CSS_PERCENTAGE
			                 ? $val_objs[$_]->getFloatValue
			                 : $val_objs[$_]->getFloatValue
			                    * 100/255 . '%',
			                0...2;
			           }
			           my $alpha;
			           @$val >= 4 && (
			            $alpha = $self->alpha->cssText
			           ) != 1
			            ? "rgba($ret, $alpha)"
			            : "rgb($ret)"
			          }
			         }

lib/CSS/DOM/Value/Primitive.pm  view on Meta::CPAN

 my $type = $self->[type];
 require CSS'DOM'Exception,
 die new CSS'DOM'Exception INVALID_ACCESS_ERR, "Not a string value"
  unless $type == CSS_STRING || $type == CSS_URI
      || $type == CSS_IDENT  || $type == CSS_ATTR;

 "$$self[valu]"
}

# ------------- Rect interface --------------- #

sub _autoviv_rect_value {
 my($self,$index) = @_;
 for my $val($$self[valu][$index]) {
  if(ref $val eq 'ARRAY') {
   $val = new
    __PACKAGE__,
     owner => $$self[ownr],
     format => '<length>|auto',
     @$val;
   delete $$self[csst]; # prevent this from being used by cssText; hence-
  }                     # forth we must use the subvalues
  return $val
 }
}

sub top { _autoviv_rect_value $_[0], 0 }
sub right { _autoviv_rect_value $_[0], 1 }
sub bottom { _autoviv_rect_value $_[0], 2 }
sub left { _autoviv_rect_value $_[0], 3 }

# ------------- RGBColor interface --------------- #

sub _autoviv_colour_value {
 my($self,$index) = @_;
 if(ref $$self[valu] ne 'ARRAY') {
  if($$self[valu] =~ /^#(..|.)(..|.)(..|.)/) {
   my $x = -length($1) + 3;
   $$self[sfrm] = '#' . length $1;
   no strict 'refs';
   $$self[valu] = [
    map([type => CSS_NUMBER, value => hex $$_ x$x], 1...3),
   ];
  }
  else {
   our %Colours or require "CSS/DOM/Value/Primitive/colours.pl";
   my $rgb = $Colours{lc($$self[sfrm] = $$self[valu])};
   $$self[valu] = [
    map
     [type => CSS_NUMBER, value => $_],
     @$rgb
   ];
  }
 }
 for my $val($$self[valu][$index]) {
  if(ref $val eq 'ARRAY') {
   $val = new
    __PACKAGE__,
     owner => $$self[ownr],
     format => $index == 3 ? '<number>' : '<number>|<percentage>',
     @$val;
   delete $$self[csst];
  }
  elsif(!defined $val and $index == 3) { # alpha
   $val = new
    __PACKAGE__,
     owner => $$self[ownr],
     format => '<number>',
     type => CSS_NUMBER,
     value => 1; 
   delete $$self[csst];
  }
  return $val
 }
}

sub red { _autoviv_colour_value $_[0], 0 }
sub green { _autoviv_colour_value $_[0], 1 }
sub blue { _autoviv_colour_value $_[0], 2 }
sub alpha { _autoviv_colour_value $_[0], 3 }

                              !()__END__()!

=head1 NAME

CSS::DOM::Value::Primitive - CSSPrimitiveValue class for CSS::DOM

=head1 VERSION

Version 0.17

=head1 SYNOPSIS

  # ...

=head1 DESCRIPTION

This module implements objects that represent CSS primitive property 
values (as opposed to lists). It
implements the DOM CSSPrimitiveValue, Rect, and RGBColor interfaces.

=head1 METHODS

If you need the constructor, it's below the object methods. Normally you
would get an object via L<CSS::DOM::Style's C<getPropertyCSSValue>
method|CSS::DOM::Style/getPropertyCSSValue>.

=head2 CSSValue Interface

=over 4

=item cssText

Returns a string representation of the attribute. Pass an argument to set 
it.

=item cssValueType

Returns C<CSS::DOM::Value::CSS_PRIMITIVE_VALUE>.