#!/usr/bin/perl

use strict;
use warnings;

use Gtk2 -init;
use Image::Magick;

my $fixed = Gtk2::Fixed->new;
$fixed->set_has_window(1); # wichtig, damit das Widget eine Windowid bekommt.
$fixed->signal_connect (expose_event => \&redraw);

my $button=Gtk2::Button->new_with_label('TEST');
$button->set_size_request(70,30);
$button->signal_connect( clicked => sub{ $fixed->move($button, 100, 100); } );

$fixed->put($button, 50, 50);

my $win = Gtk2::Window->new;
$win->set_title ('TEST');
$win->set_border_width (10);
$win->set_default_size (300, 300);
$win->signal_connect (delete_event => sub { Gtk2->main_quit; });
$win->add ($fixed);

$win->show_all; # aufrufen sonst kann die WindowID nicht ermittelt werden!
redraw();

Gtk2->main;
exit(0);

################################################################
# Funktionen ###################################################
################################################################
sub redraw
{
 my $gdkwin=$fixed->window; # windowID ermitteln
 my $allocation = $fixed->allocation;
 my ($width,$height)=($allocation->width,$allocation->height);
 my $magick=create_image($width,$height);
 my $pixmap=magick_to_pixmap($magick);
 $gdkwin->set_back_pixmap($pixmap);
}


sub magick_to_pixmap
{
 my $magick=shift;
 my $depth=8;
 my @data=$magick->ImageToBlob(magick=>'RGBA', colorspace=>'RGB', depth=>$depth);
 my $b=$magick->Get('columns');
 my $h=$magick->Get('rows');
 my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data ($data[0],'GDK_COLORSPACE_RGB',1,$depth,$b,$h,$b*4);
 my $pixmap = $pixbuf->render_pixmap_and_mask(0);
 return $pixmap;
}

sub create_image
{
 my ($width,$heigth) = @_;
 my $img=Image::Magick->new;
 $img->Set(size=>$width.'x'.$heigth);
 my $mpx=int($width/2);
 my $mpy=int($heigth/2);
 $img->Read('xc:white');
 $img->Draw(fill=>'red', stroke=>"black", strokewidth=>5, primitive=>'circle', points=>"$mpx,$mpy ".($mpx-60).",$mpy");
 $img->Annotate(text=> '!', stroke=>"black", fill=>"black", x=>($mpx-15), y=>($mpy+35), pointsize=>100, font=>"arial");
 return $img;
}

ppm install http://gtk2-perl.sourceforge.net/win32/ppm/Glib.ppd
ppm install http://gtk2-perl.sourceforge.net/win32/ppm/Gtk2.ppd