# 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;