[system] / trunk / pg / macros / parserParametricLine.pl Repository:
ViewVC logotype

Diff of /trunk/pg/macros/parserParametricLine.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 4997 Revision 5075
42=cut 42=cut
43 43
44# 44#
45# Define a new context for lines 45# Define a new context for lines
46# 46#
47$context{ParametricLine} = Context("Vector")->copy(); 47$context{ParametricLine} = Parser::Context->getCopy(undef,"Vector");
48$context{ParametricLine}->variables->are(t=>'Real'); 48$context{ParametricLine}->variables->are(t=>'Real');
49$context{ParametricLine}->{precedence}{ParametricLine} = 49$context{ParametricLine}->{precedence}{ParametricLine} =
50 $context{ParametricLine}->{precedence}{special}; 50 $context{ParametricLine}->{precedence}{special};
51$context{ParametricLine}->reduction->set('(-x)-y'=>0); 51$context{ParametricLine}->reduction->set('(-x)-y'=>0);
52# 52#
53# Make it active 53# Make it active
54# 54#
65package ParametricLine; 65package ParametricLine;
66our @ISA = qw(Value::Formula); 66our @ISA = qw(Value::Formula);
67 67
68sub new { 68sub new {
69 my $self = shift; my $class = ref($self) || $self; 69 my $self = shift; my $class = ref($self) || $self;
70 my $context = (Value::isContext($_[0]) ? shift : $self->context);
70 my ($p,$v,$line,$t); 71 my ($p,$v,$line,$t);
71 return shift if scalar(@_) == 1 && ref($_[0]) eq $class; 72 return shift if scalar(@_) == 1 && ref($_[0]) eq $class;
72 $_[0] = Value::Point->new($_[0]) if ref($_[0]) eq 'ARRAY'; 73 $_[0] = $context->Package("Point")->new($context,$_[0]) if ref($_[0]) eq 'ARRAY';
73 $_[1] = Value::Vector->new($_[1]) if ref($_[1]) eq 'ARRAY'; 74 $_[1] = $context->Package("Vector")->new($context,$_[1]) if ref($_[1]) eq 'ARRAY';
74 if (scalar(@_) >= 2 && Value::class($_[0]) eq 'Point' && 75 if (scalar(@_) >= 2 && Value::classMatch($_[0],'Point') &&
75 Value::class($_[1]) eq 'Vector') { 76 Value::classMatch($_[1],'Vector')) {
76 $p = shift; $v = shift; 77 $p = shift; $v = shift;
77 $t = shift || Value::Formula->new('t'); 78 $t = shift || $context->Package("Formula")->new($context,'t');
78 $line = $p + $t*$v; 79 $line = $p + $t*$v;
79 } else { 80 } else {
80 $line = Value::Formula->new(shift); 81 $line = $context->Package("Formula")->new($context,shift);
81 Value::Error("Your formula doesn't look like a parametric line") 82 Value::Error("Your formula doesn't look like a parametric line")
82 unless $line->type eq 'Vector'; 83 unless $line->type eq 'Vector';
83 $t = shift || (keys %{$line->{variables}})[0]; 84 $t = shift || (keys %{$line->{variables}})[0];
84 Value::Error("A line can't be just a constant vector") unless $t; 85 Value::Error("A line can't be just a constant vector") unless $t;
85 $p = Value::Point->new($line->eval($t=>0)); 86 $p = $context->Package("Point")->new($context,$line->eval($t=>0));
86 $v = Value::Vector->new($line->eval($t=>1) - $p); 87 $v = $context->Package("Vector")->new($context,$line->eval($t=>1) - $p);
87 Value::Error("Your formula isn't linear in the variable %s",$t) 88 Value::Error("Your formula isn't linear in the variable %s",$t)
88 unless $line == $p + Value::Formula->new($t) * $v; 89 unless $line == $p + $context->Package("Formula")->new($context,$t) * $v;
89 } 90 }
90 Value::Error("The direction vector for a parametric line can't be the zero vector") 91 Value::Error("The direction vector for a parametric line can't be the zero vector")
91 if ($v->norm == 0); 92 if ($v->norm == 0);
92 $line->{p} = $p; $line->{v} = $v; 93 $line->{p} = $p; $line->{v} = $v;
93 $line->{isValue} = $line->{isFormula} = 1; 94 $line->{isValue} = $line->{isFormula} = 1;
95} 96}
96 97
97=head3 compare($lhs,$rhs) 98=head3 compare($lhs,$rhs)
98 99
99# 100#
100# Two parametric lines are equal if they have 101# Two parametric lines are equal if they have
101# parallel direction vectors and either the same 102# parallel direction vectors and either the same
102# points or the vector between the points is 103# points or the vector between the points is
103# parallel to the (common) direction vector. 104# parallel to the (common) direction vector.
104# 105#
105 106
106=cut 107=cut
107 108
108sub compare { 109sub compare {
109 my ($l,$r,$flag) = @_; 110 my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
110 if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
111 $r = ParametricLine->new($r);
112 if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
113 my ($lp,$lv) = ($l->{p},$l->{v}); 111 my ($lp,$lv) = ($l->{p},$l->{v});
114 my ($rp,$rv) = ($r->{p},$r->{v}); 112 my ($rp,$rv) = ($r->{p},$r->{v});
115 return $lv <=> $rv unless ($lv->isParallel($rv)); 113 return $lv <=> $rv unless ($lv->isParallel($rv));
116 return 0 if $lp == $rp || $lv->isParallel($rp-$lp); 114 return 0 if $lp == $rp || $lv->isParallel($rp-$lp);
117 return $lp <=> $rp; 115 return $lp <=> $rp;
129# 127#
130# Report some errors that were stopped by the showEqualErrors=>0 above. 128# Report some errors that were stopped by the showEqualErrors=>0 above.
131# 129#
132sub cmp_postprocess { 130sub cmp_postprocess {
133 my $self = shift; my $ans = shift; 131 my $self = shift; my $ans = shift;
134 my $error = $$Value::context->{error}{message}; 132 my $error = $sef->context->{error}{message};
135 $self->cmp_error($ans) 133 $self->cmp_error($ans)
136 if $error =~ m/^(Your formula (isn't linear|doesn't look)|A line can't|The direction vector)/; 134 if $error =~ m/^(Your formula (isn't linear|doesn't look)|A line can't|The direction vector)/;
137} 135}
138 136
1391; 1371;

Legend:
Removed from v.4997  
changed lines
  Added in v.5075

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9