view release on metacpan or  search on metacpan

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

   'foreground=s',   \$foreground,
   'background=s',   \$background,

   'datetime-timezone=s', sub {
     my ($opt, $value) = @_;
     require DateTime::TimeZone;
     $clock_properties{'timezone'} = DateTime::TimeZone->new (name => $value);
   },
   'help-datetime-names' => sub {
     require DateTime::TimeZone;
     my @names = DateTime::TimeZone->all_names;
     { local $,="\n"; print @names,''; }
     exit 0;
   },
  )
  or exit 1; # for unknown option

if (@ARGV) {
  print "Unrecognised option '$ARGV[0]'\n";
  exit 1;
}

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

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