#!/usr/athena/bin/perl

use strict;
use warnings;

######################################################################
package Shape;

sub new {
# Subclasses should override this abstract method.
# Creates a new shape.
    die "Cannot call abstract method Shape->new()";
}

sub get_color {
# Returns the color of the shape.
# my $color = $shape->get_color();

    # Get object
    my $self = shift;

    # Return attribute
    return $self->{Color};
}

sub set_color {
# Sets the color of the shape.
# $shape->set_color($color);

    # Get object
    my $self = shift;

    # Get attributes
    my ($color) = @_;

    # Set attributes
    $self->{Color} = $color;
}


######################################################################
package Polygon;

# use base qw( Shape ); # if this package were in a different file
our @ISA = qw( Shape );

sub area {
# Subclasses should override this abstract method.
# Returns the area of the polygon.
# my $area = $polygon->area();
    die "Cannot call abstract method Polygon->area()";
}


######################################################################
package Triangle;

our @ISA = qw( Polygon );

sub new {
# Creates a new triangle.
# my $tri = Triangle->new($A);              # equilateral
# my $tri = Triangle->new($A, $B);          # isosceles; $C = $B
# my $tri = Triangle->new($A, $B, $C);      # scalene

    # Get class
    my $proto = shift;
    my $class = ref($proto) || $proto;            # Allow for object method

    # Get sides
    my ($A, $B, $C) = @_;
    $A = $proto->get_A() if ref($proto) and not defined $A;
    $B = $proto->get_B() if ref($proto) and not defined $B;
    $C = $proto->get_C() if ref($proto) and not defined $C;

    # Check sides and set defaults
    die "Must provide at least one side" unless defined $A and $A > 0;
    $B = $A unless defined $B and $B > 0;
    $C = $B unless defined $C and $C > 0;
    my ($x, $y, $max) = sort {$a <=> $b} ($A, $B, $C);
    die "Impossible triangle ($A, $B, $C)"
	if ($x + $y < $max);

    # Create object
    my $self = {
		A => $A,
		B => $B,
		C => $C,
	       };
    bless $self, $class;

    return $self;
}

sub get_A {
# Returns the appropriate side of the triangle.
# my $side = $shape->get_A();
    # Get object
    my $self = shift;
    # Return attribute
    return $self->{A};
}

sub get_B {
# Returns the appropriate side of the triangle.
# my $side = $shape->get_B();
    # Get object
    my $self = shift;
    # Return attribute
    return $self->{B};
}

sub get_C {
# Returns the appropriate side of the triangle.
# my $side = $shape->get_C();
    # Get object
    my $self = shift;
    # Return attribute
    return $self->{C};
}

sub perimeter {
# Returns the perimeter of the triangle.
# my $area = $tri->perimeter();
    # Get object
    my $self = shift;
    # Calculate value
    my $perimeter = $self->get_A() + $self->get_B() + $self->get_C();
    # Return value
    return $perimeter;
}

sub area {
# Returns the area of the triangle.
# my $area = $tri->area();
    # Get object
    my $self = shift;
    # Calculate value (using Heron's Method)
    my $s = $self->perimeter() / 2;
    my $area = sqrt($s *
		    ($s - $self->get_A()) *
		    ($s - $self->get_B()) *
		    ($s - $self->get_C()));
    # Return value
    return $area;
}


######################################################################
package Quadrilateral;

our @ISA = qw( Polygon );

sub new {
# Creates a new quadrilateral.
# my $quad = Quadrilateral->new($A);              # equilateral
# my $quad = Quadrilateral->new($A, $B);          # $C = $A; $D = $B
# my $quad = Quadrilateral->new($A, $B, $C);      # $D = $B
# my $quad = Quadrilateral->new($A, $B, $C, $D);

    # Get class
    my $proto = shift;
    my $class = ref($proto) || $proto;            # Allow for object method

    # Get sides
    my ($A, $B, $C, $D) = @_;
    $A = $proto->get_A() if ref($proto) and not defined $A;
    $B = $proto->get_B() if ref($proto) and not defined $B;
    $C = $proto->get_C() if ref($proto) and not defined $C;
    $D = $proto->get_D() if ref($proto) and not defined $D;

    # Check sides and set defaults
    die "Must provide at least one side" unless defined $A and $A > 0;
    $B = $A unless defined $B and $B > 0;
    $C = $A unless defined $C and $C > 0;
    $D = $B unless defined $D and $D > 0;
    my ($x, $y, $z, $max) = sort {$a <=> $b} ($A, $B, $C, $D);
    die "Impossible quadrilateral ($A, $B, $C, $D)"
	if ($x + $y + $z < $max);

    # Create object
    my $self = {
		A => $A,
		B => $B,
		C => $C,
		D => $D,
	       };
    bless $self, $class;

    return $self;
}

sub get_A {
# Returns the appropriate side of the quadrilateral.
# my $side = $shape->get_A();
    # Get object
    my $self = shift;
    # Return attribute
    return $self->{A};
}

sub get_B {
# Returns the appropriate side of the quadrilateral.
# my $side = $shape->get_B();
    # Get object
    my $self = shift;
    # Return attribute
    return $self->{B};
}

sub get_C {
# Returns the appropriate side of the quadrilateral.
# my $side = $shape->get_C();
    # Get object
    my $self = shift;
    # Return attribute
    return $self->{C};
}

sub get_D {
# Returns the appropriate side of the quadrilateral.
# my $side = $shape->get_D();
    # Get object
    my $self = shift;
    # Return attribute
    return $self->{D};
}

sub perimeter {
# Returns the perimeter of the quadrilateral.
# my $area = $quad->perimeter();
    # Get object
    my $self = shift;
    # Calculate value
    my $perimeter = $self->get_A() + $self->get_B() +
	            $self->get_C() + $self->get_D();
    # Return value
    return $perimeter;
}

sub area {
# Returns the area of the quadrilateral.
# my $area = $quad->area();
    die "I didn't want to do the math for this";
}


######################################################################
package Parallelogram;

our @ISA = qw( Quadrilateral );

sub area {
# Returns the area of the parallelogram.
# my $area = $para->area();
    die "I didn't want to do the math for this";
}


######################################################################

package Rectangle;

our @ISA = qw( Parallelogram );

sub new {
# Creates a new rectangle.
# my $rect = Rectangle->new($A);                  # equilateral
# my $rect = Rectangle->new($A, $B);

    # Get class
    my $proto = shift;
    my $class = ref($proto) || $proto;            # Allow for object method

    # Get sides
    my ($A, $B) = @_;

    # Create object
    my $self = $proto->SUPER::new($A, $B);
    bless $self, $class;

    return $self;
}

sub area {
# Returns the area of the rectangle.
# my $area = $rect->area();

    # Get object
    my $self = shift;

    # Get area
    my $area = $self->get_A() * $self->get_B();

    # Return attribute
    return ($area);
}


######################################################################

package Rhombus;

our @ISA = qw( Parallelogram );

sub new {
# Creates a new rhombus.
# my $rhombus = Rhombus->new($a);                  # equilateral

    # Get class
    my $proto = shift;
    my $class = ref($proto) || $proto;            # Allow for object method

    # Get sides
    my ($A) = @_;

    # Create object
    my $self = $proto->SUPER::new($A);
    bless $self, $class;

    return $self;
}

sub area {
# Returns the area of the rectangle.
# my $area = $rect->area();

    # Get object
    my $self = shift;

    # Get area
    die "Don't know angle yet";
    my $area;

    # Return attribute
    return ($area);
}


######################################################################

package Square;

our @ISA = qw( Rectangle Rhombus );

sub new {
# Creates a new square.
# my $square = Square->new($a);

    # Get class
    my $proto = shift;
    my $class = ref($proto) || $proto;            # Allow for object method

    # Get sides
    my ($A) = @_;

    # Create object
    my $self = $proto->SUPER::new($A);
    bless $self, $class;

    return $self;
}

sub area {
# Returns the area of the square.
# my $area = $square->area();

    # Get object
    my $self = shift;

    # Get area
    my $area = $self->get_A() ** 2;

    # Return attribute
    return ($area);
}


######################################################################

1;