<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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-&gt;new()            create with default (0,0,0,0)
#  $box2 = box-&gt;new(xu,yu,xo,yo) create with (xu,yu,xo,yo)
#  $box3 = box-&gt;new($loc)        create with (x,y,x,y)
#  $box4 = $box1-&gt;new()          clone $loc1
#
sub new
{
    my $r_bbox;
    my $pck = shift;    # first parameter is class name
    if (ref($pck))
    # called as instance method $locobject-&gt;new()
    {
	$r_bbox = { "xu" =&gt; $pck-&gt;{"xu"},
		    "yu" =&gt; $pck-&gt;{"yu"},
		    "xo" =&gt; $pck-&gt;{"xo"},
		    "yo" =&gt; $pck-&gt;{"yo"}
		 };
    }
    else
    # called as class method loc-&gt;new()
    {
	if (@_)
	{
	    if (ref($p1 = $_[0]) eq "loc")
	    {
		$xu = $xo = $p1-&gt;{"x"};
		$yu = $yo = $p1-&gt;{"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" =&gt; $xu,
		    "yu" =&gt; $yu,
		    "xo" =&gt; $xo,
		    "yo" =&gt; $yo
		 };
    }
    bless $r_bbox, 'bbox';
    return $r_bbox;
}


#
# initialize existing box
# $box-&gt;init()
# $box-&gt;init(x,y)
# $box-&gt;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-&gt;{"x"};
	    $yu = $yo = $p1-&gt;{"y"};
	}
	else
	# called with numbers
	{
	    $xu = $xo = $_[0];
	    $yu = $yo = $_[1];
	}
    }
    else
    # no arguments
    {
	$xu = $yu = $xo = $yo = 0;
    }
    $r_bbox-&gt;{"xu"} = $xu;
    $r_bbox-&gt;{"yu"} = $yu;
    $r_bbox-&gt;{"xo"} = $xo;
    $r_bbox-&gt;{"yo"} = $yo;
}

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


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

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


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


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


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

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


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


#
# show values
# $loc-&gt;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-&gt;{"xu"}, $r_bbox-&gt;{"yu"}, $r_bbox-&gt;{"xo"}, $r_bbox-&gt;{"yo"};
}

1;
</pre></body></html>