tests/perl/module-gtkflash

   1 #!/usr/bin/perl -w
   2
   3 # This module uses Gtk-Perl to display the flash window when page is changed.
   4 # It understands 2 dynamical commands:
   5 #     SendToModule /path/to/module-gtkflash format 'x = %d, y = %d'
   6 #     SendToModule /path/to/module-gtkflash stop
   7
   8 use lib `fvwm-perllib dir`;
   9 use FVWM::Module::Gtk;
  10 use General::Parse qw(get_tokens);
  11 init Gtk;
  12
  13 my $format = "(%d, %d)";
  14 my $module = new FVWM::Module::Gtk(Mask => M_NEW_PAGE | M_STRING);
  15
  16 $module->add_handler(M_STRING, sub {
  17         my ($module, $event) = @_;
  18         my $line = $event->_text;
  19         my ($action, @args) = get_tokens($line);
  20
  21         if ($action eq "stop") {
  22                 $module->terminate;
  23         } elsif ($action eq "format") {
  24                 $format = $args[0];
  25         }
  26 });
  27
  28 my $last_window = undef;
  29 $module->add_handler(M_NEW_PAGE, sub {
  30         my ($module, $event) = @_;
  31
  32         my $width  = $event->_vp_width;
  33         my $height = $event->_vp_height;
  34
  35         if (!$width || !$height) {
  36                 # this may happen when doing DeskTopSize 1x1 on page 2 2
  37                 return;
  38         }
  39         my $page_nx = int($event->_vp_x / $width);
  40         my $page_ny = int($event->_vp_y / $height);
  41
  42         # actually show the flash
  43         my ($w, $h) = (100, 50);
  44         my $string = sprintf($format, $page_nx, $page_ny);
  45
  46         my $window = new Gtk::Window('toplevel');
  47         $window->set_title("FlashWindow");
  48         $window->set_border_width(5);
  49         $window->set_usize($w, $h);
  50         $window->set_uposition(($width - $w) / 2, ($height - $h) / 2);
  51
  52         my $frame = new Gtk::Frame();
  53         $window->add($frame);
  54         $frame->set_shadow_type('etched_out');
  55
  56         my $label = new Gtk::Label($string);
  57         $frame->add($label);
  58         $window->show_all;
  59
  60         $last_window->destroy() if $last_window;
  61         $last_window = $window;
  62
  63         # alarm is not called in perl-5.8.0, but called in earlier perls!..
  64         # probably some problem with Gtk-Perl and perl-5.8.0
  65         $SIG{ALRM} = sub {
  66                 $last_window->destroy();
  67                 $last_window = undef;
  68         };
  69         alarm(1);
  70 });
  71
  72 $module->send("Style FlashWindow UsePPosition, NoTitle, NoHandles, BorderWidth 10, StaysOnTop, WindowListSkip, NeverFocus");
  73
  74 $module->event_loop;