107 lines
2.9 KiB
Perl
Executable File
107 lines
2.9 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
|
|
package S2::NodePropGroup;
|
|
|
|
use strict;
|
|
use S2::Node;
|
|
use S2::NodeProperty;
|
|
use S2::NodeSet;
|
|
use vars qw($VERSION @ISA);
|
|
|
|
$VERSION = '1.0';
|
|
@ISA = qw(S2::Node);
|
|
|
|
sub new {
|
|
my ($class) = @_;
|
|
my $node = new S2::Node;
|
|
$node->{'groupident'} = "";
|
|
$node->{'set_list'} = 0; # true if setting a propgroup list
|
|
$node->{'list_props'} = []; # array of NodeProperty
|
|
$node->{'list_sets'} = []; # array of NodeSet
|
|
$node->{'set_name'} = 0; # true if setting the propgroup name
|
|
$node->{'name'} = undef;
|
|
bless $node, $class;
|
|
}
|
|
|
|
sub canStart {
|
|
my ($class, $toker) = @_;
|
|
return $toker->peek() == $S2::TokenKeyword::PROPGROUP;
|
|
}
|
|
|
|
sub parse {
|
|
my ($class, $toker) = @_;
|
|
my $n = new S2::NodePropGroup;
|
|
|
|
$n->setStart($n->requireToken($toker, $S2::TokenKeyword::PROPGROUP));
|
|
my $ident = $n->getIdent($toker);
|
|
$n->{'groupident'} = $ident->getIdent();
|
|
|
|
if ($toker->peek() == $S2::TokenPunct::LBRACE) {
|
|
$n->{'set_list'} = 1;
|
|
$n->requireToken($toker, $S2::TokenPunct::LBRACE);
|
|
while ($toker->peek() && $toker->peek() != $S2::TokenPunct::RBRACE)
|
|
{
|
|
my $node;
|
|
if (S2::NodeProperty->canStart($toker)) {
|
|
$node = S2::NodeProperty->parse($toker);
|
|
push @{$n->{'list_props'}}, $node;
|
|
}
|
|
elsif (S2::NodeSet->canStart($toker)) {
|
|
$node = S2::NodeSet->parse($toker);
|
|
push @{$n->{'list_sets'}}, $node;
|
|
}
|
|
else {
|
|
my $offender = $toker->peek();
|
|
S2::error($offender, "Unexpected " . $offender->toString());
|
|
}
|
|
$n->addNode($node);
|
|
}
|
|
$n->requireToken($toker, $S2::TokenPunct::RBRACE);
|
|
} else {
|
|
$n->{'set_name'} = 1;
|
|
$n->requireToken($toker, $S2::TokenPunct::ASSIGN);
|
|
my $sl = $n->getStringLiteral($toker);
|
|
$n->{'name'} = $sl->getString();
|
|
$n->requireToken($toker, $S2::TokenPunct::SCOLON);
|
|
}
|
|
|
|
return $n;
|
|
}
|
|
|
|
sub check {
|
|
my ($this, $l, $ck) = @_;
|
|
|
|
if ($this->{'set_list'}) {
|
|
foreach my $prop (@{$this->{'list_props'}}, @{$this->{'list_sets'}}) {
|
|
$prop->check($l, $ck);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub asS2 {
|
|
my ($this, $o) = @_;
|
|
}
|
|
|
|
sub asPerl {
|
|
my ($this, $bp, $o) = @_;
|
|
|
|
if ($this->{'set_name'}) {
|
|
$o->tabwriteln("register_propgroup_name(" .
|
|
$bp->getLayerIDString() . "," .
|
|
"'$this->{groupident}', " .
|
|
$bp->quoteString($this->{'name'}) . ");");
|
|
return;
|
|
}
|
|
|
|
foreach (@{$this->{'list_props'}}, @{$this->{'list_sets'}}) {
|
|
$_->asPerl($bp, $o);
|
|
}
|
|
|
|
$o->tabwriteln("register_propgroup_props(" .
|
|
$bp->getLayerIDString() . "," .
|
|
"'$this->{groupident}', [".
|
|
join(', ', map { $bp->quoteString($_->getName) } @{$this->{'list_props'}}) .
|
|
"]);");
|
|
}
|