Pull to refresh

Perl и GUI. Работа с меню

Reading time 3 min
Views 3K
Обзор виджетов Tk, я начну с рассмотрения главного меню c учетом особенностей различных ОС.

Для начала создадим заготовку для нашего приложения:

#!/usr/bin/perl -w
use strict;
use Tkx;

our $PROGNAME = 'app';
our $VERSION = '0.1';
<habracut>

my $windowingsystem = Tkx::tk_windowingsystem();
my $IS_AQUA = ($windowingsystem eq 'aqua');

# Учитывая, что имена некоторых кнопок могут различаться, 
# в OSX это Control, в Win/X11 это Ctrl, добавим еще несколько переменных
# (пригодится для хоткеев)
my $plat_acc_ctrl = ($^O eq 'darwin') ? ('Control-') : ('Ctrl+');
my $plat_evt_ctrl = ($^O eq 'darwin') ? ('Control-') : ('Control-');

# Главное окно.
my $mw = Tkx::widget->new('.');

Tkx::tk( appname => $PROGNAME );
Tkx::wm_minsize( $mw => qw(320 200) );

# новое меню прикрепляется с помощью параметра -menu
$mw->configure(
  -menu => make_menu( $mw ),
);


Tkx::MainLoop;
1;

sub on_quit {
  Tkx::tk___messageBox( -message => 'Goodbye ;]' );
  exit;
}

sub show_about {
  Tkx::tk___messageBox( -message => "$PROGNAME $VERSION" );
}

sub make_menu {
 my $mw = shift || return;

 # По умолчанию, все меню выглядит подобно в GIMP, их можно открепить
 # Поэтому, выключим данную опцию
 Tkx::option_add('*Menu.tearOff', 0)

 # ... продолжение ниже

  return $m; 
}


Все как обычно, File, Edit, Help. (меню каскадное). Новый объект создается с помощью метода new_menu(); (подобно контейнеру)

my $m = $mw->new_menu(); # Верхний уровень
my $fm = $m->new_menu(); # File
my $em = $m->new_menu(); # Edit

# А теперь, добавим наши пункты в верхний уровень
$m->add_cascade( -label => 'File', -menu => $fm, -underline => 0 );
$m->add_cascade( -label => 'Edit', -menu => $em, -underline => 0 );



Добавление осуществляется через add_cascade(), где
-label — это заголовок меню.
-menu — виджет
-underline — индекс буквы подчеркивания. Необходимо для быстрой навигации с помощью кнопки Alt+буква (нумерация идет с 0)

смотрим, что получилось.
image

Толку от пустого меню нету, поэтому «набьем» его командами

# Меню File
$fm->add_command(
  -label => 'Do something',
  -underline => 0,
  -command => sub { },
);

# разделитель
$fm->add_separator();

$fm->add_command(
  -label => 'Quit',
  -underline => 0,
  -accelerator => "${plat_acc_ctrl}Q",
  -command => [\&on_quit],
);

Tkx::bind( all => "<${plat_evt_ctrl}q>" => [\&on_quit] );

# Меню Edit
$em->add_command(
  -label => 'Cut',
  -underline => 2,
  -accelerator => "${plat_acc_ctrl}X",
  -command => sub { Tkx::event_generate(Tkx::focus(), '<<anchor>habracut</anchor>>') },
);
    
$em->add_command(
  -label => 'Copy',
  -underline => 0,
  -accelerator => "${plat_acc_ctrl}C",
  -command => sub { Tkx::event_generate(Tkx::focus(), '<<Copy>>') },
);
    
$em->add_command(
-label => 'Paste',
-underline => 0,
-accelerator => "${plat_acc_ctrl}V",
-command => sub { Tkx::event_generate(Tkx::focus(), '<<Paste>>') },
);


На пункт Quit, мы сделали хоткей (Ctrl+Q) с помощью метода bind.
Для указания «ускорителя», используется -accelerator, а само событие при нажатии это -command
command принимает указатель на подпрограмму, причем если необходимо передать ей параметры, то используем анониный массив
[\&функция, параметр1, параметр2]

File, Edit есть. Остался пункт — Help.

в X11 есть свое системное название ('help') для пункта Help. В OSX также есть меню 'apple'
Учитывая это:
my $hname = ($IS_AQUA ? 'nothelp' : 'help');
my $hm = $m->new_menu( -name => $hname );

$m->add_cascade(
  -label => 'Help',
  -menu => $hm,
  -underline => 0,
);

# .. добавляем help, homepage и т.п

if( !$IS_AQUA ) {
  $hm->add_command(
    -label => 'About',
    -underline => 0,
    -command => [\&show_about],
  );
} else {
   my $apple_menu = $m->new_menu( -name => 'apple' );
   $m->add_cascade(
     -label => $PROGNAME,
     -menu => $apple_menu,
   );

   $m->add_command(
     -label => "About $PROGNAME",
     -command => [\&show_about],
   );
}



image

Скрины с Linux/OSX добавлю позже.

Tags:
Hubs:
+17
Comments 22
Comments Comments 22

Articles