File Coverage

blib/lib/Gtk2/Ex/NoShrink.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

# Copyright 2007, 2008, 2009, 2010 Kevin Ryde

# This file is part of Gtk2-Ex-NoShrink.
#
# Gtk2-Ex-NoShrink is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Gtk2-Ex-NoShrink is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Gtk2-Ex-NoShrink.  If not, see .

package Gtk2::Ex::NoShrink;
use 5.008;
use strict;
use warnings;
use Gtk2;
use List::Util qw(min max);
use POSIX ();

our $VERSION = 4;

# set this to 1 for some diagnostic prints
use constant DEBUG => 0;

use Glib::Object::Subclass
  'Gtk2::Bin',
  signals => { size_allocate => \&do_size_allocate,
               size_request  => \&do_size_request,
             },
  properties => [Glib::ParamSpec->int
                 ('minimum-width',
                  'minimum-width',
                  '',
                  0, POSIX::INT_MAX(), # range
                  0,                   # default
                  Glib::G_PARAM_READWRITE),
                 Glib::ParamSpec->int
                 ('minimum-height',
                  'minimum-height',
                  '',
                  0, POSIX::INT_MAX(), # range
                  0,                   # default
                  Glib::G_PARAM_READWRITE),

                 Glib::ParamSpec->double
                 ('shrink-width-factor',
                  'shrink-width-factor',
                  '',
                  0, POSIX::DBL_MAX(), # range
                  0,                   # default
                  Glib::G_PARAM_READWRITE),
                 Glib::ParamSpec->double
                 ('shrink-height-factor',
                  'shrink-height-factor',
                  '',
                  0, POSIX::DBL_MAX(), # range
                  0,                   # default
                  Glib::G_PARAM_READWRITE)
                ];

sub INIT_INSTANCE {
  my ($self) = @_;

  # NoShrink doesn't draw into the window
  # (child still gets exposes on any resize though)
  $self->set_redraw_on_allocate(0);

  # per defaults in the ParamSpec's above
  $self->{'minimum_width'}  = 0;
  $self->{'minimum_height'} = 0;
  $self->{'shrink_width_factor'} = 0;
  $self->{'shrink_height_factor'} = 0;
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  my $oldval = $self->{$pname};
  $self->{$pname} = $newval;  # per default GET_PROPERTY

  if ($oldval != $newval) {
    $self->queue_resize;
  }
}

# 'size-request' class closure
#
# called by anyone interested in how big we want to be -- ask child and add
# the border width
#
sub do_size_request {
  my ($self, $req) = @_;

  my $old_min_width  = $self->{'minimum_width'};
  my $old_min_height = $self->{'minimum_height'};
  my $min_width  = $old_min_width;
  my $min_height = $old_min_height;

  my $child = $self->get_child;
  if ($child && $child->visible) {
    my $creq = $child->size_request;

    my $width_factor = $self->{'shrink_width_factor'};
    if ($width_factor > 0 && $creq->width * $width_factor <= $min_width) {
      $min_width = $creq->width;
    } else {
      $min_width = max ($min_width, $creq->width);
    }

    my $height_factor = $self->{'shrink_height_factor'};
    if ($height_factor >0 && $creq->height * $height_factor <= $min_height) {
      $min_height = $creq->height;
    } else {
      $min_height = max ($min_height, $creq->height);
    }
  }

  if (DEBUG) {
    if ($min_width  != $old_min_width || $min_height != $old_min_height) {
      print $self->get_name," request ",$min_width,"x",$min_height,
        ", extending min ",$old_min_width,"x",$old_min_height;
      if ($child) {
        my $creq = $child->size_request;
        print ", for child ", ($child->visible ? '' : '(not visible) '),
          "req ",$creq->width,"x",$creq->height;
      }
      print " border ",$self->get_border_width,"\n";
    }
  }

  # set and notify any new minimum for the width/height from the child
  #
  $self->{'minimum_width'}  = $min_width;
  $self->{'minimum_height'} = $min_height;
  # believe cleanest to notify after both width and height updated
  if ($old_min_width  != $min_width)  { $self->notify ('minimum-width'); }
  if ($old_min_height != $min_height) { $self->notify ('minimum-height'); }

  my $border_width = $self->get_border_width;
  $req->width  ($min_width  + 2*$border_width);
  $req->height ($min_height + 2*$border_width);
}

# 'size-allocate' class closure
#
# called by our parent to give us actual allocated space -- pass this down
# to the child, less the border width
#
sub do_size_allocate {
  my ($self, $alloc) = @_;
  if (my $child = $self->get_child) {
    my $border_width  = $self->get_border_width;
    my $x = $alloc->x + $border_width;
    my $y = $alloc->y + $border_width;
    my $width = max (1, $alloc->width  - 2*$border_width);
    my $height = max (1, $alloc->height - 2*$border_width);

    my $child_alloc = $child->allocation;

    if (DEBUG) {
      my $creq = $child->size_request;
      print "NoShrink child alloc ${width}x${height} at $x,$y",
        ", vs child req ",$creq->width,"x",$creq->height,
          ", and current child ",
            $child_alloc->x,",",$child_alloc->y,
              " ",$child_alloc->width,"x",$child_alloc->height,
                "\n";
    }
    if ($x != $child_alloc->x
        || $y != $child_alloc->y
        || $width != $child_alloc->width
        || $height != $child_alloc->height) {
      $child->size_allocate (Gtk2::Gdk::Rectangle->new ($x, $y, $width, $height));
    }
  }
}

1;
__END__