File: Line.pm

package info (click to toggle)
algotutor 0.8.6-3
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 580 kB
  • sloc: perl: 2,563; makefile: 41; php: 24; sh: 1
file content (80 lines) | stat: -rw-r--r-- 2,029 bytes parent folder | download | duplicates (2)
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;