Программирование GUI приложений в perl

Discussion in 'PHP' started by ph1l1ster, 26 Mar 2009.

  1. ph1l1ster

    ph1l1ster Elder - Старейшина

    Joined:
    11 Mar 2008
    Messages:
    396
    Likes Received:
    153
    Reputations:
    19
    # intro #

    Не где не видел мануала на русском, поэтому решил написать. Многие знают что посредстами перла можно создавать GUI интерфейсы. И сейчас я вам об этом немного расскажу приведя в пример простенький текстовый редактор.

    # Hello, World! #


    У кого не установлена библиотека Tk установите её:

    Code:
    cpan> install Tk
    или под active perl windows:

    Code:
    \perl\bin\ppm -> продукт Tk
    Поехали дальше.

    По старинке 'Hello, world!' :)
    загружаем:
    Code:
    use Tk;
    Создаём интерфейс для будущей программы:

    Code:
    $first = MainWindow->new(-title=>"Hello, all!");
    $first->geometry("200x65");
    MainWindow->new - саздаём новое окно.
    -title=>"Hello, all!" - как думаю уже догадались, это титл окна.
    geometry("200x65") - размеры окна.

    Code:
    $first -> Label(-text=>"Enter you name:") -> pack();
    $first -> Entry(-textvariable=>\$name ) -> pack();
    Label(-text=>"Enter you name:") - обычный Lable с надписью Enter you name:
    $first -> Entry - это уже изменяемый label, тоесть сюда мы можем записать, удалить вырезать и тд.
    -textvariable=>\$name - опция textvariable даёт понять, что нужно записать введённые символы в переменную $name

    Далее, создаём кнопку. с параметрами:
    -text=>"Enter" - надпись на кнопке
    -height=>1 - ширина
    -width=>15 - длинна
    -сommand =>\&hello - при нажатие на кнопку, выполняется подпрограмма hello

    Code:
    $first -> Button(-text=>"Enter",-height=>1,-width=>15, -сommand =>\&hello) -> pack();
    Вот. пол дела уже сделано, далее создадим подпрограмму hello

    Code:
    $second = MainWindow->new(-title=>"Hello, all");
    $second->geometry("200x20");
    $second -> Label(-text=>"Hello, $name!") -> pack();
    
    Все строчки думаю понятны. в 3 строчке выводит в Label то, что мы ввели в Enter you name: + Hello.

    обязательно заканчиваем всё это:

    Code:
    MainLoop;
    И в итоге мы получаем, вот такую мега супер прогу:

    [​IMG]

    Code:
    #!/usr/bin/perl
    use Tk;
    $first = MainWindow->new(-title=>"Hello, all!");
    $first->geometry("200x65");
    $first -> Label(-text=>"Enter you name:") -> pack();
    $first -> Entry(-textvariable=>\$name) -> pack();
    $first -> Button(
    -text=>"Enter",
    -height=>1,
    -width=>15,
    -command =>\&hello) -> pack();
    sub hello{
    $second = MainWindow->new(-title=>"Hello, all");
    $second->geometry("200x20");
    $second -> Label(-text=>"Hello, $name!") -> pack();
    }
    MainLoop;
    # Text Editor #


    Ну пожалуй и сделаем самый простенький текстовый редактор.

    самое главное:

    Code:
    use Tk; # ноу комментс
    $form = MainWindow->new(-title=>"Text Editor! (c) ph1l1ster"); # главное окно
    $form->geometry("800x600"); # размеры
    $form->resizable(0,0);# чтобы никто окно не шевелил ;)
    $form->resizable(0,0); - 0 - и окно не подвижно, то есть, изменять размеры нельзя.

    Если это текстовый редактор, естественно нужен скроулинг?)
    Поэтому создаём форму ввода вместе со скроулом:
    Code:
    $txt = $form -> Scrolled('Text',-width => 111, -height=>50,,-scrollbars=>'e') -> pack ();
    Чтобы редактор был полноценным. прикрутим выпадающее меня сверху.
    меняшки сделаем такие:

    File: New,Open,Save.Exit
    Help: About


    Code:
    #  выпадающее меню
    $bar_menu = $form -> Menu(); 
    $form -> configure(-menu => $bar_menu);
    $file = $bar_menu -> cascade(-label=>"File", -underline=>0, -tearoff => 0);#  первая кнопка
    $help = $bar_menu -> cascade(-label =>"Help", -underline=>0, -tearoff => 0);#  вторая кнопка
    $file -> command(-label => "New", -underline=>0, -command=>sub { $txt -> delete('1.0','end');} ); #  меню в первой кнопе - создать новое
    $file -> command(-label =>"Open", -underline => 0, -command => [\&open, "Open"]);#  меню в первой кнопе - открыть
    $file -> command(-label =>"Save", -underline => 0, -command => [\&save, "Save"]);#  меню в первой кнопе - сохранить
    $file_types = [ ['Text Files', '.txt'], ['All Files',   '*'],];#  типы файлов
    $file -> separator();#  разделитель
    $file -> command(-label =>"Exit", -underline => 1,-command => sub { exit } ); #  меню в первой кнопе - выход
    Сначала создаюм основное меню:
    $file = $bar_menu -> cascade
    $help = $bar_menu -> cascade

    и подменю:

    $file -> command - для каждого, у нас - New, Open, Save.Exit

    опцией -command задаём комманду после нажатия
    опция -underline отвечает за подчёркивание снизу, без него лучше, поэтому = 0

    Далее определим какие типы файлов мы будет сохранять\открывать:

    Code:
    $file_types = [ ['Text Files', '.txt'], ['All Files',   '*'],];
    Текстовые и любые, соответственно.

    Ну а теперь приступим к назачению комманд кнопкам.

    Для начала создадим новый документ. для етого тупо очистим форму:

    Code:
    $txt -> delete('1.0','end');
    Вот и все :)

    Давай теперь попробуем открыть файл, за это отвечает функция getOpenFile
    Чтобы незасорять код создадим попрограмму open

    Code:
    -command => [\&open, "Open"]
    и комманда:
    Code:
    sub open {
    $open = $form->getOpenFile(-filetypes => $file_types, -defaultextension => '.txt');}
    Сохранить, функция getSaveFile

    Code:
    -command => [\&save, "Save"]
    и комманда:
    Code:
    sub save {
    $save = $form->getSaveFile(-filetypes => $file_types, -initialfile => 'test', -defaultextension => '.txt');}
    

    Exit:
    проще ничего нет :)
    Code:
    -command => sub { exit }
    ну а теперь самое главное, для чего и пишутся проги, это About :)

    Кликом на кнопку тупо открывать другое окно:

    Code:
    $ab = MainWindow->new(-title=>"Text Editor! (c) ph1l1ster # About");
    $ab->geometry("320x150");
    $ab->resizable(0,0);
    $ab -> Label(
    -text=>"Hello! ;)
    
    This is you first GUI programm on perl :)
    
    This is very easy.
    
    
    Respect all whack members.
    
    (c) ph1l1ster | special from all")
    Думаю тут всё понятно.

    Ну вот и всё, мы подошли к концу.

    плучилось так вот:
    [​IMG]


    # The End #


    Ну вот я расскозал немного основ. Это хоть и самая малость, но банально задавать команды для нажатий кнопок и писать в форме вы уже научились.

    По мере узноваимости буду дополнять, а сейчас всё :)
     
    3 people like this.
  2. Tigger

    Tigger Elder - Старейшина

    Joined:
    27 Aug 2007
    Messages:
    936
    Likes Received:
    527
    Reputations:
    204
    Но не смотря них тема имеет свою определную важность ;)
     
  3. Sharky

    Sharky Elder - Старейшина

    Joined:
    1 May 2006
    Messages:
    487
    Likes Received:
    312
    Reputations:
    46
    это откровенно враньё ... сам когда то заморачивался ... документации ДОХ*Я как английском так и русском .

    Орфографических ошибок куча. Не насилуй мой мозг.

    Tk интерфейсы оооооооочень тормозят при выполнение каких то объёмных задач скриптом.

    Да и не несёт статья никакой смысловой нагрузки
     
    #3 Sharky, 26 Mar 2009
    Last edited: 26 Mar 2009
  4. demond

    demond Member

    Joined:
    5 Nov 2008
    Messages:
    101
    Likes Received:
    22
    Reputations:
    5
    ph1l1ster, вообще MainLoop не обязательно писать в самом конце файла. Просто до ее вызова должны быть определены все интерфейсные переменные! Да и вообще пользовать Tk для построения интерфейса, на мой субъективный взгляд, бессмысленно. Во-первых, как здесь уже упоминалось, тормозит (но это все зависит от реализации!), а во-вторых под линухом выглядит ужасно (А винду я не люблю :) )!
    По этому пользуйтесь Qt, Gtk или Wx! :)

    Магазин ВМ
     
    #4 demond, 26 Mar 2009
    Last edited: 23 May 2013
    1 person likes this.
  5. Sharky

    Sharky Elder - Старейшина

    Joined:
    1 May 2006
    Messages:
    487
    Likes Received:
    312
    Reputations:
    46
    я думаю за Qt будущее :)
     
  6. eLWAux

    eLWAux Elder - Старейшина

    Joined:
    15 Jun 2008
    Messages:
    860
    Likes Received:
    616
    Reputations:
    211
    вот эщо несколько простих примеров tk perl:

    # Create a sub window at the request of the user
    [​IMG]
    PHP:
    #!/usr/bin/perl -w
    use Tk;
    use 
    strict;

    my $mw MainWindow->new;
    $mw->geometry("400x100");
    $mw->title("Multiple Windows Test");

    my $button1 $mw->Button(
    -
    text => "Open new window",
    -
    command => \&button1_sub)->pack(-side => "top");

    $mw->Button(
    -
    text => "Exit",
    -
    command => sub{exit})->pack();

    sub button1_sub {
      
    my $subwin1 $mw->Toplevel;
      
    $subwin1->geometry("300x150");
      
    $subwin1->title("Sub Window #1");
      
    my $subwin_button $subwin1->Button(
                 -
    text => "Close window",
                 -
    command => [$subwin1 => 'destroy'])->pack();
    }

    MainLoop;

    # create radio buttons
    [​IMG]
    PHP:
    #!/usr/bin/perl -w

    use Tk;
    use 
    strict;

    my $mw MainWindow->new;
    $mw->geometry("300x100");
    $mw->title("Radio Button Test");

    my $color "Red";

    my $radio_frame $mw->Frame()->pack(-side => "top");
    $radio_frame->Label(-text=>"My favorite primary color is ")->pack(-side => "left");
    my $radio_blue $radio_frame->Radiobutton(-text => "Blue", -value => "Blue",
                                               -
    variable=> \$color)->pack(-side => "right");
    my $radio_yellow $radio_frame->Radiobutton(-text => "Yellow", -value => "Yellow",
                                                 -
    variable=> \$color)->pack(-side => "right");
    my $radio_red $radio_frame->Radiobutton(-text => "Red", -value => "Red",
                                              -
    variable=> \$color)->pack(-side => "right");

    my $button_frame $mw->Frame()->pack(-side => "bottom");
    my $button_color $button_frame->Button(-text => "OK",
                                             -
    command => \&color_sub)->pack(-side => "left");
    my $button_exit $button_frame->Button(-text => "Exit",
                                            -
    command => sub{exit})->pack(-side => "right");

    sub color_sub {
      
    $mw->messageBox(-message => "You selected $color!", -type => "ok");
    }

    MainLoop;


    # create checkbox buttons
    [​IMG]
    PHP:
    #!/usr/bin/perl -w

    use Tk;
    use 
    strict;

    my $mw MainWindow->new;
    $mw->geometry("300x150");
    $mw->title("Check Button Test");

    my $check1 'NOT CHECKED';
    my $check2 'NOT CHECKED';
    my $check3 'NOT CHECKED';

    my $check_frame $mw->Frame()->pack(-side => "top");
    $check_frame->Label(-text=>"Select some check buttons.")->pack(-side => "top")->pack();

    my $chk1 $check_frame->Checkbutton(-text => 'Check #1',
                                         -
    variable => \$check1,
                                         -
    onvalue => 'CHECKED',
                                         -
    offvalue => 'NOT CHECKED')->pack();

    my $chk2 $check_frame->Checkbutton(-text => 'Check #2',
                                         -
    variable => \$check2,
                                         -
    onvalue => 'CHECKED',
                                         -
    offvalue => 'NOT CHECKED')->pack();

    my $chk3 $check_frame->Checkbutton(-text => 'Check #3',
                                         -
    variable => \$check3,
                                         -
    onvalue => 'CHECKED',
                                         -
    offvalue => 'NOT CHECKED')->pack();

    my $button_frame $mw->Frame()->pack(-side => "bottom");
    my $ok_button $button_frame->Button(-text => 'OK',
                                           -
    command => \&check_sub)->pack(-side => "left");
    my $exit_button $button_frame->Button(-text => 'Exit',
                                            -
    command => sub{exit})->pack(-side => "right");

    sub check_sub {
      
    my $check_msg "Check #1: $check1\nCheck #2: $check2\nCheck #3: $check3";
      
    $mw->messageBox(-message => "Check Button Summary:\n$check_msg", -type => "ok");
    }

    MainLoop;

    # color buttons
    [​IMG]
    PHP:
    #!/usr/bin/perl -w

    use Tk;
    use 
    strict;

    my $mw MainWindow->new;
    $mw->geometry("300x150");
    $mw->title("Menubutton Test");

    my $main_menu $mw->Menu();
    $mw->configure(-menu => $main_menu);

    my $btn $main_menu->Menubutton(-text => "Colorful Buttons...",
                                     -
    underline => 0, -tearoff=>0);
    $btn->command(-label => "Button #1",
                  -
    activebackground => "blue",
                  -
    foreground => "blue",
                  -
    command => sub{$mw->messageBox(-message => "Button #1 Pressed")});

    $btn->command(-label => "Button #2",
                  -
    activebackground => "red",
                  -
    activeforeground => "black",
                  -
    background => "yellow",
                  -
    foreground => "green",
                  -
    command => sub{$mw->messageBox(-message => "Button #2 Pressed")});

    $btn->command(-label => "Exit", -command => sub{exit});

    MainLoop;
     
  7. eLWAux

    eLWAux Elder - Старейшина

    Joined:
    15 Jun 2008
    Messages:
    860
    Likes Received:
    616
    Reputations:
    211
    вот ,кстати, довольно понятний онлайн-учебник:
    http://www.perl.com/pub/a/1999/10/perltk/
     
    1 person likes this.