view release on metacpan or  search on metacpan

examples/gtk2-ex-clock.pl  view on Meta::CPAN

}

#------------------------------------------------------------------------------

if (defined $foreground) {
  Gtk2::Rc->parse_string (<<"HERE");
style "Gtk2_Ex_Clock_pl_style" {
  fg[NORMAL] = "$foreground"
  text[NORMAL] = "$foreground"
}
class "Gtk2__Ex__Clock" style:application "Gtk2_Ex_Clock_pl_style"
HERE
}
if (defined $background) {
  Gtk2::Rc->parse_string (<<"HERE");
style "Gtk2_Ex_Clock_pl_style" { bg[NORMAL] = "$background" }
class "GtkWindow" style:application "Gtk2_Ex_Clock_pl_style"
HERE
}

my $toplevel = Gtk2::Window->new('toplevel');
$toplevel->signal_connect (destroy => sub { Gtk2->main_quit; });
$toplevel->signal_connect
  (realize => sub {
     $toplevel->window->set_accept_focus (0);
     $toplevel->window->set_decorations (['border']);
     if (defined $geometry) {
       $toplevel->parse_geometry ($geometry);
     }
   });

my $noshrink = $toplevel;
if ($use_noshrink && eval { require Gtk2::Ex::NoShrink }) {
  $noshrink = Gtk2::Ex::NoShrink->new;
  $toplevel->add ($noshrink);
}

my $clock = Gtk2::Ex::Clock->new (%clock_properties);
$noshrink->add ($clock);

my $menu = Gtk2::Menu->new;

my $quit = Gtk2::ImageMenuItem->new_from_stock ('gtk-quit');
$quit->signal_connect (activate => sub { $toplevel->destroy });
$quit->show;
$menu->add ($quit);


$toplevel->add_events (['button-press-mask','button-motion-mask']);
$toplevel->signal_connect (button_press_event => \&button_press);
$toplevel->signal_connect (motion_notify_event => \&motion_notify);
$toplevel->signal_connect (button_release_event => \&button_release);

my ($drag_last_x_root, $drag_last_y_root);
sub button_press {
  my ($toplevel, $event) = @_;
  if ($event->button == 1) {
    $drag_last_x_root = $event->x_root;
    $drag_last_y_root = $event->y_root;
  } elsif ($event->button == 3) {
    $menu->popup (undef, undef, undef, undef,
                  $event->button, $event->time);
  }
}
sub motion_notify {
  my ($toplevel, $event) = @_;
  drag ($event->x_root, $event->y_root);
}
sub button_release {
  my ($toplevel, $event) = @_;
  if ($event->button == 1) {
    drag ($event->x_root, $event->y_root);
    $drag_last_x_root = undef;
  }
}
# In theory you're meant to move with widget $toplevel->move, not its
# underlying window, but as of Gtk 2.16.1 there's some dodginess between it
# and fvwm2; a window move works, a widget move goes to the wrong place.
sub drag {
  my ($x_root, $y_root) = @_;
  defined $drag_last_x_root or return;
  my $window = $toplevel->window || return;
  my ($x, $y) = $window->get_position;
  $window->move ($x + $x_root - $drag_last_x_root,
                 $y + $y_root - $drag_last_y_root);
  $drag_last_x_root = $x_root;
  $drag_last_y_root = $y_root;
}


$toplevel->show_all;
Gtk2->main;
exit 0;


__END__

=head1 NAME

gtk2-ex-clock.pl -- simple digital clock program

=head1 SYNOPSIS

 gtk2-ex-clock.pl [--options]

=head1 DESCRIPTION

This is a little program displaying a digital clock using
C<Gtk2::Ex::Clock>, and optionally C<DateTime::TimeZone>.

This is only meant as a bit of fun with the clock widget, since running up
the whole of Perl-Gtk2 uses much more memory than you'd like from a clock
program.  Adding a clock widget to a Perl-Gtk2 application doesn't cost much
extra, but running it standalone is a little wasteful.

Button-1 drags the clock around (as might any key/button combination the
window manager also offers for that).  Button-3 pops up a menu to quit.  On
a two-button mouse button-3 is usually the right hand button.

=head1 OPTIONS