View of /trunk/pg/lib/Parser/Context/Variables.pm

    1 #########################################################################
    2 #
    3 #  Implements the list of known variables and their types
    4 #
    5 package Parser::Context::Variables;
    6 use strict;
    7 our @ISA = qw(Value::Context::Data);
    8 
    9 #
   10 #  The named types for variables
   11 #    (you can use arbitary types by supplying an
   12 #     instance of the type rather than a name)
   13 #
   14 our %type = (
   15   'Real'    => $Value::Type{number},
   16   'Complex' => $Value::Type{complex},
   17   'Point2D' => Value::Type('Point',2,$Value::Type{number}),
   18   'Point3D' => Value::Type('Point',3,$Value::Type{number}),
   19   'Vector2D' => Value::Type('Vector',2,$Value::Type{number}),
   20   'Vector3D' => Value::Type('Vector',3,$Value::Type{number}),
   21   'Parameter' => $Value::Type{number},
   22 );
   23 
   24 sub init {
   25   my $self = shift;
   26   $self->{dataName} = 'variables';
   27   $self->{name} = 'variable';
   28   $self->{Name} = 'Variable';
   29   $self->{namePattern} = qr/[a-zA-Z][a-zA-Z0-9]*/;
   30   $self->{tokenType} = 'var';
   31   $self->{precedence} = 5;
   32   $self->{patterns}{$self->{namePattern}} = [$self->{precedence},$self->{tokenType}];
   33 }
   34 
   35 #sub addToken {}    # no tokens needed
   36 #sub removeToken {}
   37 
   38 #
   39 #  If the type is one of the names ones, use it's known type
   40 #  Otherwise if it is a Value object use its type,
   41 #  Otherwise, if it is a signed number, use the Real type
   42 #  Otherwise report an error
   43 #
   44 sub create {
   45   my $self = shift; my $value = shift; my @extra;
   46   return $value if ref($value) eq 'HASH';
   47   if (defined($type{$value})) {
   48     @extra = (parameter => 1) if $value eq 'Parameter';
   49     $value = $type{$value};
   50   } elsif (Value::isValue($value)) {
   51     $value = $value->typeRef;
   52   } elsif ($value =~ m/$self->{context}{pattern}{signedNumber}/) {
   53     $value = $type{'Real'};
   54   } else {
   55     Value::Error("Unrecognized variable type '%s'",$value);
   56   }
   57   return {type => $value, @extra};
   58 }
   59 sub uncreate {shift; (shift)->{type}};
   60 
   61 #
   62 #  Return a variable's type
   63 #
   64 sub type {
   65   my $self = shift; my $x = shift;
   66   return $self->{context}{variables}{$x}{type};
   67 }
   68 
   69 #
   70 #  Return a parameter's value
   71 #
   72 sub value {
   73   my $self = shift; my $x = shift;
   74   return $self->{context}{variables}{$x}{value};
   75 }
   76 
   77 #
   78 #  Get the names of all variables
   79 #
   80 sub variables {
   81   my $self = shift; my @names;
   82   foreach my $x ($self->SUPER::names)
   83     {push(@names,$x) unless $self->{context}{variables}{$x}{parameter}}
   84   return @names;
   85 }
   86 
   87 #
   88 #  Get the names of all parameters
   89 #
   90 sub parameters {
   91   my $self = shift; my @names;
   92   foreach my $x ($self->SUPER::names)
   93     {push(@names,$x) if $self->{context}{variables}{$x}{parameter}}
   94   return @names;
   95 }
   96 
   97 #########################################################################
   98 
   99 1;