view release on metacpan or  search on metacpan

lib/App/Chart/Gtk2/IntradayImage.pm  view on Meta::CPAN

  my $x_offset = max(0, ($alloc_width - $pix_width) / 2);
  my $y_offset = max(0, ($alloc_height - $pix_height) / 2);

  # restrict to alloc width/height, in case pixbuf+pad is bigger than alloc
  my $width  = min ($alloc_width  - $x_offset, $pix_width);
  my $height = min ($alloc_height - $y_offset, $pix_height);

  my $gc = $self->get_style->bg_gc($self->state);
  $gc->set_clip_region ($event->region);
  $win->draw_pixbuf ($gc, $pixbuf,
                     0, 0,                       # source x,y
                     $x+$x_offset, $y+$y_offset, # dest x,y
                     $width, $height,
                     'normal', # dither
                     0, 0);    # dither x,y

  my $region = $event->region->copy;
  $region->subtract (Gtk2::Gdk::Region->rectangle
                     (Gtk2::Gdk::Rectangle->new
                      ($x+$x_offset, $y+$y_offset, $width, $height)));
  $gc->set_clip_region ($region);
  $win->draw_rectangle ($gc, 1, $event->area->values);

  $gc->set_clip_region (undef);
  return Gtk2::EVENT_PROPAGATE;
}

sub _load_pixbuf {
  my ($self) = @_;
  ### _load_pixbuf() ...

  my $symbol = $self->{'symbol'};
  my $mode = $self->{'mode'};
  if (! $symbol || ! $mode) { return  __('(No data)'); }

  my $dbh = App::Chart::DBI->instance;
  my $sth = $dbh->prepare_cached
    ('SELECT image, error FROM intraday_image WHERE symbol=? AND mode=?');

  # Crib note: Some DBI 1.618 SQLite3 1.35 seems to hold a ref to the
  # scalars passed to selectrow_array() until the next call.  So use the
  # local variables since holding onto $self->{'symbol'} looks like a leak.
  #
  my ($image, $error) = $dbh->selectrow_array ($sth, undef,
                                               $symbol,
                                               $mode);
  $sth->finish();
  if (! defined $image) { # error message in database
    return $error ||  __('(No data)');
  }

  my $loader = Gtk2::Gdk::PixbufLoader->new();
  my $pixbuf;
  if (eval {
    $loader->write ($image);
    $loader->close ();
    $pixbuf = $loader->get_pixbuf;
    1 }) {
    return $pixbuf;
  } else {
    # Should be Glib::Error in $@ thrown by $loader, but allow for plain
    # string too.
    my $err = "$@";
    unless (utf8::is_utf8($err)) { $err = Encode::decode('locale',$err); }
    return $err;
  }
}

sub _do_intraday_changed {
  my ($self, $symbol, $mode) = @_;
  ### IntradayImage _do_intraday_changed(): "\"$symbol\" \"$mode\"\n"
  if ($self->{'symbol'} eq $symbol && $self->{'mode'} eq $mode) {
    # new image (or new no image)
    delete $self->{'xor_background'};  # new colour scheme
    $self->queue_resize;
    $self->queue_draw;
  }
}

#-----------------------------------------------------------------------------
# pixbuf background

sub Gtk2_Ex_Xor_background {
  my ($self) = @_;
  return ($self->{'xor_background'} ||= do {
    require Gtk2::Ex::PixbufBits;
    my $pixbuf = _load_pixbuf ($self);
    if (! ref $pixbuf) {
      # error loading, treat as widget background
      return $self->get_style->bg($self->state);
    }
    my $rgbstr = Gtk2::Ex::PixbufBits::sampled_majority_color ($pixbuf);
    ### IntradayImage xor background: $rgbstr
    require App::Chart::Gtk2::Ex::GdkColorAlloc;
    App::Chart::Gtk2::Ex::GdkColorAlloc->new (widget => $self,
                                              color => $rgbstr);
  });
}

1;
__END__

=for stopwords intraday PNG JPEG GIF

=head1 NAME

App::Chart::Gtk2::IntradayImage -- intraday image display widget

=head1 SYNOPSIS

 my $image = App::Chart::Gtk2::IntradayImage->new;
 $image->set (symbol => 'BHP.AX',
              mode   => '1d');

=head1 WIDGET HIERARCHY

C<App::Chart::Gtk2::IntradayImage> is a subclass of C<Gtk2::DrawingArea>.

    Gtk2::Widget
      Gtk2::DrawingArea
        App::Chart::Gtk2::IntradayImage