package bbox;

# 14.4.2001 IK  bugfix

# some constant values (modify in streambuf::GetPos too!)
($SB_C, $SB_R, $SB_T, $SB_TL, $SB_TR, $SB_L, $SB_B, $SB_BR, $SB_BL) =
 (0, 1, 2, 3, 4, 5, 6, 7, 8);

#
#  create new box object.
#  $box1 = box->new()            create with default (0,0,0,0)
#  $box2 = box->new(xu,yu,xo,yo) create with (xu,yu,xo,yo)
#  $box3 = box->new($loc)        create with (x,y,x,y)
#  $box4 = $box1->new()          clone $loc1
#
sub new
{
   my $r_bbox;
   my $pck = shift;    # first parameter is class name
   if (ref($pck))
   # called as instance method $locobject->new()
   {
       $r_bbox = { "xu" => $pck->{"xu"},
                   "yu" => $pck->{"yu"},
                   "xo" => $pck->{"xo"},
                   "yo" => $pck->{"yo"}
                };
   }
   else
   # called as class method loc->new()
   {
       if (@_)
       {
           if (ref($p1 = $_[0]) eq "loc")
           {
               $xu = $xo = $p1->{"x"};
               $yu = $yo = $p1->{"y"};
           }
           else
           {
               if (scalar(@_)==2)
               {
                   $xu = $xo = $_[0];
                   $yu = $yo = $_[1];
               }
               else
               {
                   $xu = $_[0];
                   $yu = $_[1];
                   $xo = $_[2];
                   $yo = $_[3];
               }
           }
       }
       else
       {
           $xu = $yu = $xo = $yo = 0;
       }
       $r_bbox = { "xu" => $xu,
                   "yu" => $yu,
                   "xo" => $xo,
                   "yo" => $yo
                };
   }
   bless $r_bbox, 'bbox';
   return $r_bbox;
}


#
# initialize existing box
# $box->init()
# $box->init(x,y)
# $box->init($loc)
#
sub init
{
   my $r_bbox = shift;
   my ($xu, $yu, $xo, $yo);
   if (@_)
   # called with arguments
   {
       if (ref($p1 = $_[0]) eq "loc")
       # called with location object
       {
           $xu = $xo = $p1->{"x"};
           $yu = $yo = $p1->{"y"};
       }
       else
       # called with numbers
       {
           $xu = $xo = $_[0];
           $yu = $yo = $_[1];
       }
   }
   else
   # no arguments
   {
       $xu = $yu = $xo = $yo = 0;
   }
   $r_bbox->{"xu"} = $xu;
   $r_bbox->{"yu"} = $yu;
   $r_bbox->{"xo"} = $xo;
   $r_bbox->{"yo"} = $yo;
}

#
# copy box dimensions
# $box->eq($box1)
#
sub eq
{
   my $r_bbox = shift;
   my ($r_box1) = @_;
   $r_bbox->{"xu"} = $r_box1->{"xu"};
   $r_bbox->{"yu"} = $r_box1->{"yu"};
   $r_bbox->{"xo"} = $r_box1->{"xo"};
   $r_bbox->{"yo"} = $r_box1->{"yo"};
}


#
#  returns width and height of box
#
sub width
{
   my $r_bbox = shift;
   return ($r_bbox->{"xo"} - $r_bbox->{"xu"});
}

sub height
{
   my $r_bbox = shift;
   return ($r_bbox->{"yo"} - $r_bbox->{"yu"});
}


#
#  $box1->minmax(x,y)
#  $box1->minmax($loc)
#  $box1->minmax($box)
#
sub MinMax
{
   my $r_bbox = shift;
   my $p1 = shift;
   if (ref($p1) eq "bbox")
   # box extends box
   {
       $r_bbox->{"xu"} = $p1->{"xu"} if $p1->{"xu"} < $r_bbox->{"xu"};
       $r_bbox->{"yu"} = $p1->{"yu"} if $p1->{"yu"} < $r_bbox->{"yu"};
       $r_bbox->{"xo"} = $p1->{"xo"} if $p1->{"xo"} > $r_bbox->{"xo"};
       $r_bbox->{"yo"} = $p1->{"yo"} if $p1->{"yo"} > $r_bbox->{"yo"};
   }
   else
   {
       if (ref($p1) eq "loc")
       # location object extends box
       {
           $r_bbox->{"xu"} = $p1->{"x"} if $p1->{"x"} < $r_bbox->{"xu"};
           $r_bbox->{"yu"} = $p1->{"y"} if $p1->{"y"} < $r_bbox->{"yu"};
           $r_bbox->{"xo"} = $p1->{"x"} if $p1->{"x"} > $r_bbox->{"xo"};
           $r_bbox->{"yo"} = $p1->{"y"} if $p1->{"y"} > $r_bbox->{"yo"};
       }
       else
       # point given
       {
           my $p2 = shift;
           $r_bbox->{"xu"} = $p1 if $p1 < $r_bbox->{"xu"};
           $r_bbox->{"yu"} = $p2 if $p2 < $r_bbox->{"yu"};
           $r_bbox->{"xo"} = $p1 if $p1 > $r_bbox->{"xo"};
           $r_bbox->{"yo"} = $p2 if $p2 > $r_bbox->{"yo"};
       }
   }
}


#
#  determines $loc so that $loc is in relation $iPos to $box
#  $box->ToConPoint($iPos, $loc)
#
sub ToConPoint
{
   my ($r_bbox, $iPos, $r_loc) = @_;
   $r_loc->{"x"} = $r_bbox->{"xo"} if grep($iPos==$_, ($SB_R, $SB_TR, $SB_BR));
   $r_loc->{"x"} = $r_bbox->{"xu"} if grep($iPos==$_, ($SB_L, $SB_TL, $SB_BL));
   $r_loc->{"x"} = ($r_bbox->{"xu"} + $r_bbox->{"xo"})/2
                                if grep($iPos==$_, ($SB_T, $SB_C, $SB_B));
   $r_loc->{"y"} = $r_bbox->{"yo"} if grep($iPos==$_, ($SB_TR, $SB_T, $SB_TL));
   $r_loc->{"y"} = $r_bbox->{"yu"} if grep($iPos==$_, ($SB_BR, $SB_B, $SB_BL));
   $r_loc->{"y"} = ($r_bbox->{"yu"} + $r_bbox->{"yo"})/2
                                if grep($iPos==$_, ($SB_L, $SB_C, $SB_R));
}


#
#  determines $loc so that $box is in relation $iPos to $locg
#  $box->OrigConPoint($iPos, $loc, $locg)
#
sub OrigConPoint
{
   my ($r_bbox, $iPos, $r_loc, $r_locg) = @_;
   $r_loc->{"x"} = $r_locg->{"x"} - $r_bbox->{"xo"}
                               if grep($iPos==$_, ($SB_R, $SB_TR, $SB_BR));
   $r_loc->{"x"} = $r_locg->{"x"} - $r_bbox->{"xu"}
                               if grep($iPos==$_, ($SB_L, $SB_TL, $SB_BL));
   $r_loc->{"x"} = $r_locg->{"x"} - ($r_bbox->{"xu"} + $r_bbox->{"xo"})/2
                               if grep($iPos==$_, ($SB_T, $SB_C, $SB_B));

   $r_loc->{"y"} = $r_locg->{"y"} - $r_bbox->{"yo"}
                               if grep($iPos==$_, ($SB_TR, $SB_T, $SB_TL));
   $r_loc->{"y"} = $r_locg->{"y"} - $r_bbox->{"yu"}
                               if grep($iPos==$_, ($SB_BR, $SB_B, $SB_BL));
   $r_loc->{"y"} = $r_locg->{"y"} - ($r_bbox->{"yu"} + $r_bbox->{"yo"})/2
                               if grep($iPos==$_, ($SB_L, $SB_C, $SB_R));
}


#
#  adds offset $loc2 or vec(x,y) to $bbox
#  $box->translate(x,y)
#  $box->translate($loc2)
#
sub translate
{
   my $r_box = shift;
   my $p1 = shift;
   if (ref($p1) eq "loc")
   {
       $r_box->{"xu"} += $p1->{"x"};
       $r_box->{"yu"} += $p1->{"y"};
       $r_box->{"xo"} += $p1->{"x"};
       $r_box->{"yo"} += $p1->{"y"};
   }
   else
   {
       my $p2 = shift;
       $r_box->{"xu"} += $p1;
       $r_box->{"yu"} += $p2;
       $r_box->{"xo"} += $p1;
       $r_box->{"yo"} += $p2;
   }
}


#
# show values
# $loc->dump( [name])
#
sub dump
{
   my $r_bbox = shift;
   my $name = shift;
   printf "%s (BBOX): xu = %f, yu = %f xo = %f yo = %f\n", $name,
       $r_bbox->{"xu"}, $r_bbox->{"yu"}, $r_bbox->{"xo"}, $r_bbox->{"yo"};
}

1;

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.