view release on metacpan or  search on metacpan

lib/SWF/Element.pm  view on Meta::CPAN

    *{"${classname}::${u}pack"} = eval($packsub) unless defined &{"${classname}::${u}pack"};
    *{"${classname}::${u}unpack"} = eval($unpacksub) unless defined &{"${classname}::${u}unpack"};
}

# Utility sub to create subclass.

sub _create_class {
    no strict 'refs';

    my $classname = shift; 
    my $isa = shift;
    my $base = ((@_ % 2) ? pop : 0);

    $classname = "SWF::Element::$classname";

    my $element_names = \@{"${classname}::_Element_Names"};
    my $element_types = \%{"${classname}::_Element_Types"};

#    $isa = [$isa] unless ref($isa) eq 'ARRAY';
    @{"${classname}::ISA"}=map {$_ ? "SWF::Element::$_" : "SWF::Element"} @$isa;
    while (@_) {
	my $k = shift;
	my $v = shift;
	my $base1 = $base;
	push @$element_names, $k;

	if ($v !~ /^\$/) {
	    my $type = $element_types->{$k} = "SWF::Element::$v";
	    *{"${classname}::$k"} = sub {
		my $self = shift;
		if (@_) {
		    my $p = $_[0];
		    if (UNIVERSAL::isa($p, $type) or not defined $p) {
			$self->[$base1] = $p;
		    } else {
			$self->[$base1] = $type->new unless defined $self->[$base1];
			$self->[$base1]->configure(@_);
		    }
		} else {
		    $self->[$base1] = $type->new unless defined $self->[$base1];
		}
		$self->[$base1];
	    };
	} else {
	    $element_types->{$k} = $v;
	    *{"${classname}::$k"} = sub {
		my ($self, $data) = @_;
		$self->[$base1] = $data if @_>=2;
		$self->[$base1];
	    };
	}

	$base++;
 
    }
}

sub _create_flag_accessor {
    no strict 'refs';
    my ($name, $flagfield, $bit, $len) = @_;
    my $pkg = (caller)[0];

    $len ||=1;
    my $field = (((1<<$len) - 1)<<$bit);

    *{"${pkg}::$name"} = sub {
	my ($self, $set) = @_;
	my $flags = $self->$flagfield || 0;

	if (defined $set) {
	    $flags &= ~$field;
	    $flags |= ($set<<$bit);
	    $self->$flagfield($flags);
	}
	return (($flags & $field) >> $bit);
    }
}

# Create subclasses.

_create_class('ID', ['Scalar']);
_create_class('Depth', ['Scalar']);
_create_class('BinData', ['Scalar']);
_create_class('RGB', [''],
	      Red   => '$UI8',
	      Green => '$UI8',
	      Blue  => '$UI8');
_create_pack('RGB');
_create_class('RGBA', ['', 'RGB'],
	      Red   => '$UI8',
	      Green => '$UI8',
	      Blue  => '$UI8',
	      Alpha => '$UI8');
_create_pack('RGBA');
_create_class('RECT', [''],
	      Xmin => '$', Ymin => '$',
	      Xmax => '$', Ymax => '$');
_create_class('MATRIX', [''],
	      ScaleX      => '$', ScaleY      => '$',
	      RotateSkew0 => '$', RotateSkew1 => '$',
	      TranslateX  => '$', TranslateY  => '$');
_create_class('CXFORM', [''],
	      Flags         => '$',
	      RedMultTerm   => '$', 
	      GreenMultTerm => '$',
	      BlueMultTerm  => '$',
	      RedAddTerm    => '$',
	      GreenAddTerm  => '$',
	      BlueAddTerm   => '$');
_create_class('CXFORMWITHALPHA', ['CXFORM'],
	      Flags         => '$',
	      RedMultTerm   => '$', 
	      GreenMultTerm => '$',
	      BlueMultTerm  => '$',
	      AlphaMultTerm => '$',
	      RedAddTerm    => '$',
	      GreenAddTerm  => '$',
	      BlueAddTerm   => '$',
	      AlphaAddTerm  => '$');
_create_class('STRING', ['Scalar']);
_create_class('PSTRING', ['STRING']);