1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
# Author: Chao-Kuei Hung
# For more info, including license, please see doc/index.html
package Line;
# straight line in R^2
use strict;
use Carp;
use vars qw(@ISA);
@ISA = qw();
use Vector2;
# Different from "Perl Cookbook", chap 13.6, p.461 "cloning objects"
# See Randal Schwartz's "Constructing Objects" at
# http://www.stonehenge.com/merlyn/UnixReview/col52.html
# (search for "three camps")
sub new {
my ($proto, %opts) = @_;
my ($class, $obj);
$class = ref $proto || $proto;
# if (ref $data[0] eq "Vector") {
if (ref $proto) {
$obj = { %$proto };
$obj->{nl} = $proto->{nl}->new();
} else {
if (not exists $opts{nl}) {
die unless exists $opts{p1} and $opts{p2};
$opts{nl} = $opts{p2} - $opts{p1};
@{ $opts{nl} } = (-$opts{nl}->[1], $opts{nl}->[0]);
}
if (not exists $opts{const}) {
die unless exists $opts{p1};
$opts{const} = $opts{p1}->dot($opts{nl});
}
$obj = { const=>$opts{const}, nl=>$opts{nl} };
}
return bless $obj, $class;
}
sub intersect {
my ($L1, $L2) = @_;
my ($d) = $L1->{nl}->x * $L2->{nl}->y - $L1->{nl}->y * $L2->{nl}->x;
return undef if abs($d) < 1e-7;
return Vector2->new(
$L1->{const} * $L2->{nl}->y - $L1->{nl}->y * $L2->{const},
$L1->{nl}->x * $L2->{const} - $L1->{const} * $L2->{nl}->x
)->pw_div($d);
}
use overload
'""' => 'stringify',
'fallback' => undef
;
sub stringify {
my ($self) = @_;
my ($r) = sprintf "%8g = %8g x",
$self->{const}, $self->{nl}->x;
if ($self->{nl}->y < 0) {
$r .= sprintf " - %8g y", -$self->{nl}->y;
} else {
$r .= sprintf " + %8g y", $self->{nl}->y;
}
return $r;
}
if ($0 =~ /Line.pm$/) {
# being tested as a stand-alone program, so run test code.
my ($L1, $L2, $L3);
$L1 = Line->new(const=>26, nl=>Vector2->new(2, 3));
$L2 = Line->new(p1=>Vector2->new(2,5), p2=>Vector2->new(3,1));
$L3 = $L1->new(); $L3->{nl}[0] = 7;
print "L1: $L1\nL2: $L2\nL3: $L3\n";
print "L1 intersects L2 at: ", $L1->intersect($L2), "\n";
}
1;
|
