Форум АНТИЧАТ - Программирование GUI приложений в perl

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)

- PHP, PERL, MySQL, JavaScript (https://forum.antichat.xyz/forumdisplay.php?f=37)

- - Программирование GUI приложений в perl (https://forum.antichat.xyz/showthread.php?t=113028)

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

# intro #

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

# Hello, World! #

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

Код:

cpan> install Tk

или под active perl windows:

Код:

\perl\bin\ppm -> продукт Tk

Поехали дальше.

По старинке 'Hello, world!' :)
загружаем:

Код:

use Tk;

Создаём интерфейс для будущей программы:

Код:

$first = MainWindow->new(-title=>"Hello, all!");

$first->geometry("200x65");

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

Код:

$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

Код:

$first -> Button(-text=>"Enter",-height=>1,-width=>15, -сommand =>\&hello) -> pack();

Вот. пол дела уже сделано, далее создадим подпрограмму hello

Код:

$second = MainWindow->new(-title=>"Hello, all");

$second->geometry("200x20");

$second -> Label(-text=>"Hello, $name!") -> pack();

Все строчки думаю понятны. в 3 строчке выводит в Label то, что мы ввели в Enter you name: + Hello.

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

Код:

MainLoop;

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

http://i009.radikal.ru/0903/8c/ebb13ed48b84.jpg

Код:

#!/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 #

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

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

Код:

use Tk; # ноу комментс

$form = MainWindow->new(-title=>"Text Editor! (c) ph1l1ster"); # главное окно

$form->geometry("800x600"); # размеры

$form->resizable(0,0);# чтобы никто окно не шевелил ;)

$form->resizable(0,0); - 0 - и окно не подвижно, то есть, изменять размеры нельзя.

Если это текстовый редактор, естественно нужен скроулинг?)
Поэтому создаём форму ввода вместе со скроулом:

Код:

$txt = $form -> Scrolled('Text',-width => 111, -height=>50,,-scrollbars=>'e') -> pack ();

Чтобы редактор был полноценным. прикрутим выпадающее меня сверху.
меняшки сделаем такие:

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

Код:

#  выпадающее меню

$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

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

Код:

$file_types = [ ['Text Files', '.txt'], ['All Files', '*'],];

Текстовые и любые, соответственно.

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

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

Код:

$txt -> delete('1.0','end');

Вот и все :)

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

Код:

-command => [\&open, "Open"]

и комманда:

Код:

sub open {

$open = $form->getOpenFile(-filetypes => $file_types, -defaultextension => '.txt');}

Сохранить, функция getSaveFile

Код:

-command => [\&save, "Save"]

и комманда:

Код:

sub save {

$save = $form->getSaveFile(-filetypes => $file_types, -initialfile => 'test', -defaultextension => '.txt');}

Exit:
проще ничего нет :)

Код:

-command => sub { exit }

ну а теперь самое главное, для чего и пишутся проги, это About :)

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

Код:

$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")

Думаю тут всё понятно.

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

плучилось так вот:
http://s59.radikal.ru/i166/0903/c5/a11c430562e8.jpg

# The End #

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

По мере узноваимости буду дополнять, а сейчас всё :)

Ошибок орфографических куча,исправь.

Цитата:

Сообщение от rushter

Ошибок орфографических куча,исправь.

Но не смотря них тема имеет свою определную важность ;)

Цитата:

Сообщение от Tigger

Но не смотря них тема имеет свою определную важность ;)

Я статью не читал,но мельком заметил уже около 10 ошибок,опечаток.Согласись не приятно читать ?

Цитата:

Не где не видел мануала на русском, поэтому решил написать.

это откровенно враньё ... сам когда то заморачивался ... документации ДОХ*Я как английском так и русском .

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

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

Да и не несёт статья никакой смысловой нагрузки

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

Цитата:

Сообщение от demond

я думаю за Qt будущее :)

вот эщо несколько простих примеров tk perl:

# Create a sub window at the request of the user
http://s60.radikal.ru/i169/0903/53/63f58fcff746.jpg

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
http://i035.radikal.ru/0903/d7/da04456a5b5a.jpg

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
http://s42.radikal.ru/i097/0903/c3/ead6b83dae00.jpg

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
http://s61.radikal.ru/i174/0903/77/82d81cb129a7.jpg

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;

вот ,кстати, довольно понятний онлайн-учебник:
http://www.perl.com/pub/a/1999/10/perltk/