#!/usr/bin/perl -w

#############################################################################
# Size - a size/dimension value, that can depend on another value
#
# Copyright (C) 1999-2000 by Tels. All rights reserved.
#############################################################################

package CoW::Size;
use vars qw($VERSION);
$VERSION = 1.00;    # Current version of this package
require  5.005;     # requires this Perl version or later

use base CoW::Item;
#@EXPORT_OK     = qw( );
#@EXPORT        = qw( );
use strict;
use vars qw($AUTOLOAD);

use overload
        '*' => \&scale,
        '+' => \&add,
        '-' => \&sub,
        '<=>' => sub { $_[0]->absolute() <=> $_[1]; },
        'cmp' => sub { my $a = $_[0]->absolute(); "$a" cmp "$_[1]"; },
        '+0' => \&absolute,
        '""' => \&absolute;

#############################################################################
# private, initialize self

sub _init
  {
  my $self = shift;
  my $args = shift;

  $self->SUPER::_init($args);
  $self->SUPER::_default( {
   rel => '', val => 0, snap => 0,
   } );
  die "illegal rel field $self->{rel}"
   unless $self->{rel} eq '' || $self->{rel} =~ /^((self|_parent)::|)[a-z]+/;
  return $self;
  }

#############################################################################
# public
 
sub absolute
  {
  my $self = shift;

  my $abs = $self->{val};
  if ($self->{rel} ne '')
    {
    $abs = $self->_rel() * $self->{val};    # works due to overload
    }
  $abs = $self->{min} if (defined $self->{min}) && ($abs < $self->{min});
  $abs = $self->{max} if (defined $self->{max}) && ($abs > $self->{max});
  return $abs;
  }
 
sub _rel
  {
  # return the value of referenced by $self->{rel}
  my $self = shift;
  my $r = shift; $r = $self->{rel} if !defined $r;
  return 0 if $r eq '';
  my ($parent,$val) = split /::/,$r; 
  ($val,$parent) = ($parent,'') if !defined $val;
  if ($parent eq '_parent')
    {
    $parent = $self->{_parent}->{_parent};
    }
  else
    {
    $parent = $self->{_parent};
    }
  die "Illegal relative reference to '$r'" if !ref($parent);
  my $v = $parent->{$val};
  die ("Field '".($val||'')."' undefined in $parent ($parent->{name}), rel was '$r'")
   if !defined $v;
  return "$v";
  }

sub scale
  {
  my $self = shift;
  my $factor = shift || return $self;

  $self->{val} *= $factor;
  return $self;
  }

sub add
  {
  my $self = shift;
  my $ofs = shift || return $self;

  $self->{val} += $ofs;
  return $self;
  }
 
sub sub
  {
  my $self = shift;
  my $ofs = shift || 0;

  $self->{val} -= $ofs;
  return $self;
  }

sub rel
  {
  my $self = shift;

  if (defined $_[0])
    {
    $self->{rel} = shift;
    # make a check, will die if it does not work
    my $val = $self->_rel() if $self->{rel} ne '';
    }
  return $self->{rel};
  }

sub val
  {
  my $self = shift;

  $self->{val} = shift if defined $_[0];
  return $self->{val};
  }

1; 

__END__

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

=pod

=head1 NAME

CoW::Size - a dimension that can be relative to another value.

=cut

=head1 SYNOPSIS

        use CoW::Size;

        $width = new CoW::Size ( rel => '_parent::w', val => 1.0 );

        print $width->absolute();       # width's absolute value based on rel

=head1 REQUIRES

perl5.005, overload, L<Item|Item>

=head1 EXPORTS

Exports nothing.

=head1 DESCRIPTION

This module defines a size/dimension that can be relative to
another value. See L<Angle|Angle> for angle coordinates and L<Coord|Coord>
for relative coordinates.
C<Size> overloads the stringify routine, so that you can use

        use CoW::Size;

        $size = new CoW::Size ( rel => '', val => 50 );

        print $size,"\n";               # prints "50\n";
        print $size->absolute(),"\n";   # the same
        $simple = $size->absolute();    # put 50 into simple

It also overloads multiply/add/subtract, so that

        $size *= 2;
        print $size,"\n";
        $size += 20;
        print $size,"\n";

work as expected. L<Thing|Thing> uses this for scaling itself.

See also L<Item|Item>.

=head1 FIELDS

=over 2

=item rel

Specifies wether the L<value|val> is relative or absolut. If set to '',
the value is absolute, otherwise rel specifies the field where the value
is relativ to. Use '_parent:: to make it relative to the parent. Examples:

        $size->rel('_parent::w');       # relative to parents width (aka to
                                        # $coord->{_parent}->{_parent}->{w}
        $size->rel('_self::l);          # relative to own lenght (self is the
                                        # object the coord belongs to, aka
                                        # $coord->{_parent}->{l})
        $size->rel('l');                # dito as last example

=item val

The actual value.

=item snap

Currently unimplemented.

The actual value will always be snapped to the gridsize given by C<snap>. If
snap is 1, then C<absolute()> will always give you -1,0,1,2 etc, but never
0.5. The actual value will be rounded to the nearest snap value. This
implements the grid/gridsize in Dromed, think of it as a rounding factor.

A value of 0 (the default) means no snapping takes place.

=item min

The minimum absolute value. If the value after conversion to absolute is
smaller than C<min>, it will be set to C<max>.

=item max

The maximum absolute value. If the value after conversion to absolute is
greater than C<max>, it will be set to C<max>.

=back

=head1 METHODS

=head2 absolute

Return the absolute value of this dimension based on it's rel value (this
might traverse the entire tree upwards up to the root).

        print $size->absolute();

=head2 rel

Sets/gets the L<rel|rel> field, and does check wether the new C<rel> field
is valid.

=head2 val

Sets/gets the L<val|val> field and returns the new value.

=head2 scale

Multiply the dimension by the given factor. Works for absolute as well as for
relative coordinates.

=head2 add and sub

Add/subtract the given offset to/from self. Works for absolute as well as for
relative values. Note that for relative sizes, you can only add
relative values (although the actual value you can add/subtract is unlimited):

        use CoW::Size;
        use CoW::Thing;

        $c = new Cow::Size ( rel => 'l', val => 0.5 );
        $t = new CoW::Thing ( l => 32, w => $c );
        print "$c\n";                                   # 16
        $c->add(1.5);                                   # set val to 1.5
        print "$c\n";                                   # 48

It is not possible to add f.i. absolut 16 to C<val>, since it is not known
which value has except by using C<absolute();> and this depends on the current
value of C<$t->{l}>.

=head1 BUGS

None known yet.

=head1 AUTHOR

Tels http://bloodgate.com in late 2000.

=cut

