view release on metacpan or  search on metacpan

gtk-demo/pixbufs.pl  view on Meta::CPAN

#!/usr/bin/perl -w
#
# Pixbufs
#
# A GdkPixbuf represents an image, normally in RGB or RGBA format.
# Pixbufs are normally used to load files from disk and perform
# image scaling.
#
# This demo is not all that educational, but looks cool. It was written
# by Extreme Pixbuf Hacker Federico Mena Quintero. It also shows
# off how to use GtkDrawingArea to do a simple animation.
#
# Look at the Image demo for additional pixbuf usage examples.
#
#

package pixbufs;

use Glib qw(TRUE FALSE);
use Gtk2;
use strict;

chdir '../gtk-demo';

use constant FRAME_DELAY => 50;

use constant BACKGROUND_NAME => "background.jpg";

my @image_names = (
  "apple-red.png",
  "gnome-applets.png",
  "gnome-calendar.png",
  "gnome-foot.png",
  "gnome-gmush.png",
  "gnome-gimp.png",
  "gnome-gsame.png",
  "gnu-keys.png"
);

# demo window
my $window = undef;

# Current frame
my $frame;

# Background image
my $background;
my ($back_width, $back_height);

# Images
my @images;

# Widgets
my $da;

# Loads the images for the demo.
# croaks if anything goes wrong.
sub load_pixbufs {
  return TRUE if $background; # already loaded earlier

  # demo_find_file() looks in the the current directory first,
  # so you can run gtk-demo without installing GTK, then looks
  # in the location where the file is installed.
  #
  my $filename = main::demo_find_file (BACKGROUND_NAME);

  $background = Gtk2::Gdk::Pixbuf->new_from_file ($filename);

  $back_width = $background->get_width;
  $back_height = $background->get_height;

  foreach my $i (@image_names) {
      push @images, Gtk2::Gdk::Pixbuf->new_from_file (
	      		main::demo_find_file ($i));
  }

  return TRUE;
}

# Expose callback for the drawing area
sub expose_cb {
  my ($widget, $event) = @_;

  # the C code that this replaces used gdk_pixbuf_get_pixels and
  # gdk_draw_rgb_image_dithalign, with pointer math to find the
  # correct index in the image data; that doesn't work well with
  # perl scalars, and besides, the GdkPixbuf method render_to_drawable
  # exists for this very purpose.
  $frame->render_to_drawable ($widget->window, $widget->style->black_gc,
                              $event->area->x, $event->area->y,
                              $event->area->x, $event->area->y,
                              $event->area->width, $event->area->height,