perl/curses/edit.pl

   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