################################################################################
#
#  kPerl Logics/Mathematics Library Group
#  Object Library for 2D Kartesian Point or Point Vector
#
#  copyright (c)
#    Karol Szafranski, 2005
#    UPenn Philadelphia, Center for Bioinformatics, 2004
#    Institute of Molecular Biotechnology Jena, Dept. Genome Analysis, 2001
#  author
#    Karol Szafranski, karol.szafranski@leibniz-fli.de
#
################################################################################
#
#  DESCRIPTION
#
# - switches are always set library-wide, i.e. all active objects are affected.
#   The way to set switches is just an assignment to the library switch hash,
#   like:
#     $Math::Geomet2dPoint::LibGlob{switch}{-debug} = 1;
#   cmp. passage 'DEBUG, CHANGES, ADDITIONS'
#
# - individual description of functions at the beginning of the code blocks
#
################################################################################
#
#  OBJECT OPERATORS
#
# - data type conversion
#   bool           always TRUE
#   @{}            ( $x, $y )
#                  this is the explicitly implemented data structure
#   %{}            ( x=>$x, y=>$y )
#
# - calculation
#   neg            multiply with -1
#   =              reference assignment(!)
#   +=  +          vector addition
#   -=  -          vector addition
#   *=  *          vector stretch
#   /=  /          vector stretch
#
#  OBJECT METHODS  for external access
#
# - housekeeping
#   new            return object, possible initializations (via ini()):
#                  - without args, yielding (0,0)
#                  - with 1 arg (object) to yield copy of object
#                  - with 2 args: return vector ($arg1,$arg2) = ($x,$y)
#   ini            object initialization, args of new()
#   new_randdir    return random vector with normalized length
#   clone          return copy of object
#   copy           return copy of object, alias of clone()
#   string         represent object in compact string format using brackets
#
# - attributes and calculations
#   dim            dimension of matrix, constantly 2
#   amount         determine amount of point vector
#   radian         determine radian angle of vector
#   norm_direct    return normalized direction vector
#   stretch        stretch vector, i.e. multiply with float
#                  [this should be implemented via overload of '*']
#   add            add another vector
#   points2vectors turn a list of points to a list of connecting vectors
#   transform      transform vector/point by matrix
#
#
#  OBJECT DATA STRUCTURE
#
# - array: (x,y)
#
################################################################################
#
#  FUNCTIONS, DATA
#
#   @ISA
#   overload
#   %LibGlob
#
# - housekeeping
#   $LibGlob{switch}
#   &new  see MainLib::DefaultObjArray.pm
#   &ini  called by &new
#   &new_randdir
#   &clone
#   &copy
#   &string
#
# - attributes and calculations
#   &dim
#   &amount
#   &radian
#   &stretch
#   &add
#   &points2vectors
#   &transform
#
#
#  STD OPTIONS
#
#  -debug      print debug protocol to STDERR
#
################################################################################
#
#  DEBUG, CHANGES, ADDITIONS
#
# - turn the object into a hash-based architecture
#   That way, as typical for OO, switches could be set object-specific. This is
#   usually done by a method called AddSwitch(), which is "declared" in the
#   meta-class MainLib::DefaultObjHash.
#   ---
#   Well, so far there was no need for switch attributes
#
# - look also for notes in the header of each function block
#
################################################################################

package Math::Geomet2dPoint;

# includes
use strict; #use warnings;  # OK 20090321
use POSIX qw(asin);
use Math::kCalc;
use MainLib::DefaultObjArray;
### beware: ###
### use Math::kCalc qw(&stretch);
  # stretch() is defined as an object-specific method here

# inheritance
our @ISA;
push @ISA, qw(MainLib::DefaultObjArray);

# overload
use overload (
'""'   => # make the stringify operator work like for non-overloaded object references
          sub { \@{$_[0]} },
'bool' => sub { 1; },
#'@{}'  => '',  # This works without explicit conversion
'%{}'  => sub { return { 'x'=>$_[0][0], 'y'=>$_[0][1] }; },
'neg'  => sub { $_[0]->clone()->stretch(-1) },
#
#'abs'  => sub { new Math::BigFloat &fabs },
## We could define a method that calculates the quadrant I vector
## Does it make sense?
#
'='    => sub { $_[0] },
'+='   => sub { $_[0]->add($_[1]) },
'+'    => sub { $_[0]->clone()->add($_[1]) },
'-='   => sub { $_[0]->add(-$_[1]) },
'-'    => sub { $_[0]->clone()->add(-$_[1]) },
'*='   => sub { $_[0]->stretch($_[1]) },
'*'    => sub { $_[0]->clone()->stretch($_[1]) },
'/='   => sub { $_[0]->stretch(1/$_[1]) },
'/'    => sub { $_[0]->clone()->stretch(1/$_[1]) },
#'x'    => sub { print "Math::Geomet2dPoint::x. arguments:\n";
#                map { printf "  %s\n", $_ } @_ },
);

# package-wide constants and variables
our (%LibGlob);


################################################################################
# housekeeping
################################################################################


$LibGlob{switch} = {};


# parametric initialization
#
# INTERFACE
# - argument 0:  object reference, from method new()
# - argument 1*: either:
#                - existing object (function as a copy constructor)
#                - x position, y position
#                - reference to array of x position and y position
#                - none => point for Kartesian origin
#
# - library options:
#   -debug      [STD]
#
# - return val: object reference
#
# DESCRIPTION
# - this function will be called by method new(), as a constructor sub-function.
#
sub ini {
  my ($this,@arg) = @_;
  my $debug = $LibGlob{switch}{-debug};

  # construct from submitted data argument(s)
  if (@arg) {

    # convert refs to array, likewise for object of this same class
    if (int(@arg) == 1) {
      if (ref($arg[0]) eq 'ARRAY' and int(@{$arg[0]})==2) {
        @arg = @{$arg[0]};
      } elsif (ref($arg[0]) eq __PACKAGE__) {
        @arg = @{$arg[0]};
      } else {
        die sprintf "%s. ERROR: unable to interpret arguments: %s\n", (caller(0))[3],
          join(',',@arg)||"''";
      }
    }

    # assign from array of coordinate values
    if (int(@arg) == 2) {
      @$this = @arg;
      $debug and printf STDERR "%s. assigning from arguments: %s\n", (caller(0))[3], $this->string();
    }

    # arg number error
    else {
      die sprintf "%s. ERROR: too many arguments: %d\n", (caller(0))[3], int(@arg);
    }
  }

  # null point
  else {
    @$this = (0) x 2;
    $debug and printf STDERR "%s. assigning default: %s\n", (caller(0))[3], $this->string();
  }

  return $this;
}


# random vector with normalized length
#
# INTERFACE
# - return val: random vector object
#
sub new_randdir {
  require Math::kRandom;
  require Math::kCalc;
  my ($class,$len) = @_;
  $len ||= 1;
  my $ang = rand() * 2 * $Math::kCalc::const{pi};
  $class->new($len*cos($ang),-$len*sin($ang));
}


# copy object
#
# INTERFACE
# - return val: reference to copy of object
#
sub clone { bless [ @{$_[0]} ] }

sub copy { &clone(@_) }


# compact string representation of object
#
# INTERFACE
# - options:
#   -fmt        full sprintf format string. Note: the sprintf expression has
#               two numerical arguments!
#   -fmtfloat   sprintf format substring for float conversion, default %s
#   -label      object label, default "point"
# - return val: string representation
#
sub string {
  my ($this,%opt) = @_;
  my $lbl = $opt{-label} || 'point';
  my $fmtfloat = $opt{-fmtfloat} || '%s';
  my $fmt = $opt{-fmt} || "$lbl($fmtfloat,$fmtfloat)";
  eval 'sprintf($fmt,@{$this})' || '* fmt error *';
}


################################################################################
# attributes and calculations
################################################################################


# vector's dimension
#
sub dim { 2 }


# vector's amount
#
# INTERFACE
# - return val: amount
#
sub amount {
  my ($this) = @_;
  return sqrt ($this->[0]**2 + $this->[1]**2);
}


# vector's radian angle
#
# INTERFACE
# - return val: radian angle
#
sub radian {
  my ($this) = @_;
  my $ang = asin($this->norm_direct()->[1]);
  if ($this->[0]<0) {
    $ang = ($ang>0)? $const{pi}-$ang : -$const{pi}-$ang;
  }
  return $ang;
}


# return normalized direction vector
#
# INTERFACE
# - argument 0: object reference
# - return val: vector with normalized length
#
# DESCRIPTION
# - A null vector evaluates to a null vector.
#
sub norm_direct {
  my ($this) = @_;
  my $amt = $this->amount();
  if ($amt) {
    return $this->copy()->stretch(1/$amt);
  } else {
    return $this->new();
  }
}


# stretch vector (multiply with floating point), overload on operator "*="
#
# INTERFACE
# - argument 1: multiplier
#
# - library options:
#   -debug      [STD]
#
# - return val: passed object reference
#
# DEVELOPER'S NOTES
# - multiplication makes sense only for vectors, actually not for points. This
#   method will move to derived class "Geomet2dVector" if it's once created.
#
sub stretch {
  my ($this,$multiplier) = @_;
  $multiplier||=0;
  my $debug = $LibGlob{switch}{-debug};
  if (ref ($multiplier)) {
    die sprintf "%s. ERROR: unable to interpret argument: %s\n", (caller(0))[3], $multiplier||"''";
  }

  # apply multiplier
  $this->[0] *= $multiplier;
  $this->[1] *= $multiplier;

  return $this;
}


# add another vector, overload on operator "+="
#
# INTERFACE
# - argument 1: reference to vector
# - return val: object reference (self!)
#
# DEVELOPER'S NOTES
# - the rather long sequence to obtain the addend vector is to allow addend
#   operands other than this same class, but process operands of this same class
#   as fast as possible.
#
sub add {
  my ($this,@ArgVec) = @_;
  my $pAddend;
  if (ref($pAddend=$ArgVec[0]) ne __PACKAGE__) {
    unless ($pAddend = eval(sprintf('%s->new(@ArgVec)',__PACKAGE__))) {
      die sprintf "%s. ERROR: unable to interpret arguments: %s\n", (caller(0))[3],
        join (',', @ArgVec);
    }
  }

  # recalculate coordinates
  $this->[0] += $pAddend->[0];
  $this->[1] += $pAddend->[1];

  return $this;
}


# turn a list of points to a list of connecting vectors
#
# INTERFACE
# - argument 1+: list of points
# - return val:  list of vectors (n-1)
#
sub points2vectors {
  my ($this,@ArgVec) = @_;
  if (int(@ArgVec) < 1) {
    die sprintf "%s. ERROR: bad number of arguments\n", (caller(0))[3], int(@ArgVec);
  }

  my @ConnectVec;
  while (my $pVec = shift @ArgVec) {
    push @ConnectVec, $pVec-$this;
    $this = $pVec;
  }
  return @ConnectVec;
}


# transform by matrix object
#
# INTERFACE
# - argument 1: reference to matrix object
# - return val: transformed point (passed object reference)
#
sub transform {
  my ($this,$pMatrix) = @_;
  if (ref($pMatrix) ne 'Math::Geomet2dTrform') {
    die sprintf "%s. ERROR: unable to interpret argument: %s\n", (caller(0))[3], $pMatrix||"''";
  }

  # apply matrix
  my $pPt0 = $this->clone();
  $this->[0] = $pMatrix->[0][0]*$pPt0->[0] + $pMatrix->[1][0]*$pPt0->[1] + $pMatrix->[2][0];
  $this->[1] = $pMatrix->[0][1]*$pPt0->[0] + $pMatrix->[1][1]*$pPt0->[1] + $pMatrix->[2][1];

  return $this;
}


1;
# $Id: Geomet2dPoint.pm,v 1.22 2018/06/05 18:02:56 szafrans Exp $
