################################################################################
#
#  kPerl Logics/Mathematics Library Group
#  Object Library for 2D Kartesian Transformation Matrix
#
#  copyright (c)
#    Karol Szafranski, 2005,2009
#    UPenn Philadelphia, Center for Bioinformatics, 2004
#    Institute of Molecular Biotechnology Jena, Dept. Genome Analysis, 2001
#  author
#    Karol Szafranski, karol.szafranski@leibniz-fli.de
#
################################################################################
#
#  DESCRIPTION
#
# - purpose and background
#   The matrix representation of a geometrical (2D) transformation  defines a
#   polynome that transforms a source coordinate object to a new coordinate
#   position. The matrix fields are defined as follows:
#
#             ---to---
#              x    y
#
#      | x    x2x  x2y
#   from y    y2x  y2y
#      | .    02x  02y
#
# - 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::Geomet2dTrform::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
#   @{}            [ [$x2x,$x2y], [$y2x,$y2y], [$n2x,$n2y] ]
#                  this is the explicitly implemented data structure
#
# - calculation
#   x              combine transformations $a/$b, apply transformation $b to
#                  point $a
#
#  OBJECT METHODS  for external access
#
# - housekeeping
#   new            constructor, possible initializations (via ini()):
#                  - without args, yielding NULL transformation
#                  - with object arg, yielding clone of an object
#                  - with 3 args (ARRAY references, each ARRAY containing two
#                    values), serving for explicit matrix assignment
#   ini            object initialization, args of new()
#   clone          return copy of object
#   string         represent object in compact string format using brackets
#   dim            dimension of matrix, constantly 2
#
# - matrix representation of common transformations
#   new_null       like method new
#   new_move       return matrix representing move by vector [$x,$y]
#   new_rotate     return matrix representing rotation at (0,0) by radian angle
#
# - matrix calculation
#   append         add subsequent matrix transformation
#   combine        return successive combination of two matrices
#
#
#  OBJECT DATA STRUCTURE
#
#   2D array:
#   corresponding to a matrix of 3 lines keeping 2 elements each
#
################################################################################
#
#  FUNCTIONS, DATA
#
#   @ISA
#   overload
#   %LibGlob
#   %_LibParam
#
# - housekeeping
#   $LibGlob{switch}
#   $_LibParam{null}
#   &new  see MainLib::DefaultObjArray.pm
#   &ini
#   &clone
#   &string
#   &dim
#
# - matrix representation of common transformations
#   &new_null
#   &new_move
#   &new_rotate
#
# - matrix calculation
#   &append
#   &combine
#
################################################################################
#
#  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 pre-defined
#   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::Geomet2dTrform;

# includes
use strict; #use warnings;  # OK 20090321
use MainLib::DefaultObjArray;
use MainLib::Data;

# 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
'x'    => sub { &combine ($_[0], $_[1]) },
);

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


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


$LibGlob{switch} = {};

$_LibParam{null} = [[1,0],[0,1],[0,0]];


# parametric initialization
#
# INTERFACE
# - argument 0: class or object reference
# - argument 1: initialization argument
#
# - 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) = @_;

  # construct from submitted data structure
  if (ref ($arg)) {

    # assign from refs
    if (ref($arg) eq 'ARRAY' and int(@$arg)==3) {
      @$this = map{@{$_||[]}} &DataClone([@{$arg}]);
    } elsif (ref($arg) eq __PACKAGE__) {
      $this = $arg->clone();
    } else {
      die sprintf "%s. ERROR: unable to interpret argument %s\n", (caller(0))[3], $arg||"''";
    }
  }

  # assign null transformation
  else {
    @$this = map{@{$_||[]}} &DataClone($_LibParam{null});
  }

  return $this;
}


# copy object
#
# INTERFACE
# - return val: reference to copy of object
#
sub clone {
  my ($this) = @_;
  my $pCopy = &DataClone([@$this])
    or die sprintf "%s. ERROR in cloning data structure\n", (caller(0))[3];
  bless ($pCopy, ref($this));
}


# compact string representation of object
#
# INTERFACE
# - options:
#   -fmtfloat   sprintf format substring for float conversion, default %s
#   -label      object label, default "transform"
# - return val: string representation
#
sub string {
  my ($this,%opt) = @_;
  my $lbl = $opt{-label} || 'transform';
  my $fmtfloat = $opt{-fmtfloat} || '%s';
  sprintf ("%s([%s],[%s],[%s])", $lbl,
    map { join(',',map{ sprintf($fmtfloat,$_) }@$_) } @{$this});
}


# object's dimension
#
sub dim { 2 }


################################################################################
# matrix representation of common transformations
################################################################################


# matrix representation of NULL transformation
#
# INTERFACE
# - return val: requested matrix
#
sub new_null {
  return $_[0]->new();
}


# matrix representation of vector transformation
#
# INTERFACE
# - argument 0: class or object reference
# - argument 1: vector initialization arguments
# - return val: requested matrix
#
sub new_move {
  require Math::Geomet2dPoint;
  my ($this,@ArgVec) = @_;
  my $pVec = eval('Math::Geomet2dPoint->new(@ArgVec)');
  if (not $pVec) {
    die sprintf "%s. ERROR: unable to interpret argument as a vector: %s\n", (caller(0))[3],
      join(',',@ArgVec)||"''";
  }

  # initialize as a NULL transformation and add vector transformation
  my $pNew = $this->new();
  $pNew->[2][0] = $$pVec[0];
  $pNew->[2][1] = $$pVec[1];

  return $pNew;
}


# matrix representation of rotation at (0,0)
#
# INTERFACE
# - argument 0: class or object reference
# - argument 1: radian angle
# - return val: requested matrix
#
# DESCRIPTION
# - the radian angle definition starts with 0 on the right, turning counter-
#   clockwise.
#
sub new_rotate {
  my ($this,$angle) = @_;

  my $ValSin = sin($angle);
  my $ValCos = cos($angle);
  my $pNew = [
    [  $ValCos,  $ValSin ],
    [ -$ValSin,  $ValCos ],
    [  0,        0       ],
  ];

  bless $pNew;
}


################################################################################
# matrix calculation
################################################################################


# combine with another transformation (mutator)
#
# INTERFACE
# - return val: reference to another matrix
# - return val: object reference
#
sub append {
  my ($this,$pMat2) = @_;
  my $pComb = $this->combine($pMat2);
  @$this = @$pComb;
  return $this;
}

# combine with another transformation
#
# INTERFACE
# - return val: reference to another matrix
# - return val: joint matrix
#
sub combine {
  my ($this,$pMat2) = @_;
  if (ref($pMat2) ne __PACKAGE__) {
    die sprintf "%s. ERROR: unable to interpret argument: %s\n", (caller(0))[3], $pMat2||"''";
  }

  # combine matrices
  my $pComb = $this->clone();
  $pComb->[0][0] = $pMat2->[0][0]*$this->[0][0] + $pMat2->[1][0]*$this->[0][1];
  $pComb->[0][1] = $pMat2->[0][1]*$this->[0][0] + $pMat2->[1][1]*$this->[0][1];
  $pComb->[1][0] = $pMat2->[0][0]*$this->[1][0] + $pMat2->[1][0]*$this->[1][1];
  $pComb->[1][1] = $pMat2->[0][1]*$this->[1][0] + $pMat2->[1][1]*$this->[1][1];
  $pComb->[2][0] = $pMat2->[0][0]*$this->[2][0] + $pMat2->[1][0]*$this->[2][1] + $pMat2->[2][0];
  $pComb->[2][1] = $pMat2->[0][1]*$this->[2][0] + $pMat2->[1][1]*$this->[2][1] + $pMat2->[2][1];

  return $pComb;
}


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