| 1 | #!/usr/bin/env perl |
| 2 | #pacman -S perl-curses-ui |
| 3 | |
| 4 | use utf8; |
| 5 | use I18N::Collate; |
| 6 | setlocale('LC_COLLATE', 'cs_CZ.utf8'); |
| 7 | use encoding 'UTF-8'; |
| 8 | |
| 9 | use warnings; |
| 10 | use strict; |
| 11 | |
| 12 | use Curses::UI; |
| 13 | |
| 14 | our $path = "/home"; |
| 15 | our $file = ""; |
| 16 | |
| 17 | my $cui = new Curses::UI(-color_support => 1, -language => "czech"); |
| 18 | my @menu = ( |
| 19 | { |
| 20 | -label => 'Soubor', -submenu => |
| 21 | [ |
| 22 | {-label => 'Nacist Ctrl-O', -value => \&open_file}, |
| 23 | {-label => 'Ulozit Ctrl-S', -value => \&save}, |
| 24 | {-label => 'Konec Ctrl-X', -value => \&exit_dialog} |
| 25 | ] |
| 26 | }, |
| 27 | { |
| 28 | -label => 'Napoveda', -submenu => |
| 29 | [ |
| 30 | {-label => 'O aplikaci', -value => \&about}, |
| 31 | ] |
| 32 | }, |
| 33 | ); |
| 34 | |
| 35 | #menu |
| 36 | my $menu = $cui->add( |
| 37 | "menu", |
| 38 | "Menubar", |
| 39 | -menu =>\@menu, |
| 40 | -fg => "white", |
| 41 | -bg => "blue" |
| 42 | ); |
| 43 | |
| 44 | |
| 45 | my $win = $cui->add( |
| 46 | "win", |
| 47 | "Window", |
| 48 | -y => 2, |
| 49 | -x => 0, |
| 50 | -border => 0 |
| 51 | ); |
| 52 | |
| 53 | my $label = $win->add( |
| 54 | "label", "Label", |
| 55 | -x => 0, |
| 56 | -y => 0, |
| 57 | -bold => 1, |
| 58 | ); |
| 59 | |
| 60 | my $texteditor = $win->add( |
| 61 | "text", |
| 62 | "TextEditor", |
| 63 | -hscrollbar => 1, |
| 64 | -vscrollbar => 1,-y=>2, |
| 65 | -border=>1 |
| 66 | ); |
| 67 | $texteditor->focus(); |
| 68 | |
| 69 | open_file($ARGV[0]) if $ARGV[0] && (-r $ARGV[0]); |
| 70 | |
| 71 | |
| 72 | $cui->set_binding(\&open_file, "\cO"); |
| 73 | $cui->set_binding(\&save, "\cS"); |
| 74 | $cui->set_binding(\&exit_dialog, "\cX"); |
| 75 | $cui->set_binding(sub {$menu->focus();}, "\t"); |
| 76 | |
| 77 | $cui->mainloop(); |
| 78 | |
| 79 | sub exit_dialog { |
| 80 | my $return = $cui->dialog( |
| 81 | -message => "Chcete ukoncit program?", |
| 82 | -title => "Jste si jisty?", |
| 83 | -buttons => ['yes', 'no'], |
| 84 | ); |
| 85 | exit(0) if $return; |
| 86 | } |
| 87 | |
| 88 | sub open_file { |
| 89 | my $soubor = shift; |
| 90 | $soubor = $cui->loadfilebrowser( |
| 91 | -path => $path |
| 92 | ) unless -r $soubor; |
| 93 | |
| 94 | if($soubor and -r $soubor and -T $soubor){ |
| 95 | local $/ = undef; |
| 96 | open DATA, $soubor; |
| 97 | my $data = <DATA>; |
| 98 | $texteditor->text($data); |
| 99 | close DATA; |
| 100 | ($path) = $soubor =~ /^(.*\/).*$/; |
| 101 | $file = $soubor; |
| 102 | $label->text("Soubor: ".$file); |
| 103 | }else{ |
| 104 | $cui->error("Nevybral jste soubor"); |
| 105 | } |
| 106 | return $soubor; |
| 107 | } |
| 108 | |
| 109 | sub save { |
| 110 | my $soubor = $cui->savefilebrowser( |
| 111 | -path => $path, |
| 112 | ); |
| 113 | |
| 114 | if(defined $soubor){ |
| 115 | local $/ = undef; |
| 116 | open CIL, ">$soubor"; |
| 117 | print CIL $texteditor->get(); |
| 118 | close CIL; |
| 119 | ($path) = $soubor =~ /^(.*\/).*$/; |
| 120 | $file = $soubor; |
| 121 | $label->text("Soubor: ".$file); |
| 122 | }else{ |
| 123 | $cui->error("Nevybral jste soubor"); |
| 124 | } |
| 125 | } |
| 126 | |
| 127 | sub about { |
| 128 | $cui->dialog("Toto je napoveda"); |
| 129 | } |
| 130 | |