package CursesChatMainwindow; use strict; use Curses; use Term::ReadKey; use Exporter; our @ISA = qw/Exporter/; our @EXPORT = qw/printline select_buffer current_buffer/; our $HEIGHT; our $WIDTH; our $MAINWIN; our $stdiowatcher; our $current_buffer_scroll = 0; our $current_buffer = "status"; our $winbuffers = {}; our $input_cb = sub {}; our @history; our $inputbuffer; our $inputoffset = 0; our $cursor = 0; our $statusline; $SIG{WINCH} = sub { my ($wc, $hc, $wpx, $hpx) = GetTerminalSize (); resizeterm ($hc, $wc); $MAINWIN->resize ($hc, $wc); $HEIGHT = $hc; $WIDTH = $wc; $MAINWIN->erase; refresh (); }; sub color2attr { my $c = $_[0]; my $attr; if ($c <= 63) { $attr = COLOR_PAIR($c); } elsif ($c <= 127) { $c -= 64; $attr = COLOR_PAIR($c) | A_BOLD; } elsif ($c <= 191) { $c -= 128; $attr = COLOR_PAIR($c) | A_UNDERLINE; } else { $c -= 192; $attr = COLOR_PAIR($c) | A_UNDERLINE | A_BOLD; } $attr } sub register_input_cb { my ($cb) = @_; $input_cb = $cb; } sub _draw_attr_line_at { my ($line, $attrline) = @_; my @lcont = @$attrline; my $li = 0; while (@lcont > 0) { my ($color, $str) = (shift @lcont, shift @lcont); $MAINWIN->attron (color2attr ($color)); my $sl = length $str; if (($li + $sl) > $WIDTH) { $sl = $WIDTH - $li; last if $sl < 0; } $MAINWIN->addnstr ($line, $li, (substr $str, 0, $sl), $sl); $li += $sl; $MAINWIN->attroff (color2attr ($color)); } } sub clog { open LOG, ">>/tmp/debuglog"; print LOG @_; close LOG; } sub wrap_attr_lines { my ($width, @lines) = @_; my @outlines; for my $line (@lines) { my $wrap_padding = 0; my @cline = @$line; my @oline; my $outc = 0; while (@cline) { my ($color, $str) = (shift @cline, shift @cline); if ($color =~ m/^p\s*(\d+)\s*$/) { $wrap_padding = $1; ($color, $str) = ($str, shift @cline); } my $strlen = length $str; if (($outc + $strlen) > $width) { my $thisl = $width - $outc; push @oline, ($color, substr $str, 0, $thisl); push @outlines, [@oline]; @oline = (); unshift @cline, ($color, substr $str, $thisl); if ($wrap_padding && $wrap_padding < $width) { unshift @cline, (0, ' ' x $wrap_padding); } $outc = 0; } else { push @oline, ($color, $str); $outc += $strlen; } } push @outlines, [@oline]; } # my $i = 0; # for my $line (@outlines) { # clog ("LINE$i: ".join ('|',@$line)."\n"); # $i++; # } @outlines; } sub refresh_lines { $MAINWIN->erase; my @revwin = @{$winbuffers->{$current_buffer} || []}; if (scalar @revwin > ($HEIGHT + $current_buffer)) { (@revwin) = splice @revwin, -$HEIGHT; } my (@out_lines) = reverse wrap_attr_lines ($WIDTH, @revwin); if ($current_buffer_scroll > 0) { if ($current_buffer_scroll > scalar (@out_lines)) { $current_buffer_scroll = scalar (@out_lines); } @out_lines = splice @out_lines, $current_buffer_scroll; clog ("SPLICE$current_buffer_scroll [".(scalar @out_lines)."]\n"); } _draw_attr_line_at ($HEIGHT - 2, $statusline || [0, 'nothing']); my $line = $HEIGHT - 3; while ($line >= 0) { my $l = shift @out_lines; last unless defined $l; _draw_attr_line_at ($line--, $l); } } sub refresh { my ($onlyinput) = @_; refresh_lines unless $onlyinput; $MAINWIN->move ($HEIGHT - 1, 0); $MAINWIN->clrtoeol (); my $padding = $WIDTH - int ($WIDTH / 1.2); if ($cursor >= ($WIDTH - $padding)) { my $iobuf = $inputbuffer; my $il = length $iobuf; my $ncursor = $cursor; my $lcursor = $cursor - int ($WIDTH / 1.2); $ncursor -= $lcursor; substr $iobuf, 0, $lcursor, ''; $MAINWIN->addstr ($HEIGHT - 1, 0, (substr $iobuf, 0, $WIDTH)); $MAINWIN->move ($HEIGHT - 1, $ncursor); } else { $MAINWIN->addstr ($HEIGHT - 1, 0, (substr $inputbuffer, 0, $WIDTH)); $MAINWIN->move ($HEIGHT - 1, $cursor); } $MAINWIN->refresh; } sub select_buffer { $current_buffer = $_[0]; $current_buffer_scroll = 0; refresh (); } sub current_buffer { $current_buffer } sub printline { if ($_[0] eq 'statusline') { $statusline = $_[1]; } else { push @{$winbuffers->{(defined $_[0] ? $_[0] : "status")}}, $_[1]; } refresh (); } sub input { my $c = $MAINWIN->getch; if ($c == KEY_BACKSPACE) { if ($cursor > 0) { substr $inputbuffer, --$cursor, 1, ''; } } elsif ($c == KEY_DC) { substr $inputbuffer, $cursor, 1, ''; } elsif ($c == KEY_LEFT) { $cursor-- if $cursor > 0; } elsif ($c == KEY_RIGHT) { $cursor++ if (($cursor + 1) <= (length $inputbuffer)); } elsif ($c == KEY_PPAGE) { $current_buffer_scroll += int ($HEIGHT / 2); } elsif ($c == KEY_NPAGE) { $current_buffer_scroll -= int ($HEIGHT / 2); $current_buffer_scroll = 0 if $current_buffer_scroll < 0; } elsif ($c eq "\n") { push @history, $inputbuffer; $input_cb->($inputbuffer); $inputbuffer = ""; $cursor = 0; } else { if ($c > 255) { printline (status => [0, "SPECIAL[$c]"]); } else { if (ord ($c) == 27) { my $nxt = $MAINWIN->getch; $input_cb->(undef, $nxt); return; } else { substr $inputbuffer, $cursor++, 0, $c; } } } refresh (); } sub init { my $win = $MAINWIN = Curses->new; cbreak; noecho; clear; $win->keypad (1); ($HEIGHT, $WIDTH) = ($LINES, $COLS); if (has_colors ()) { start_color (); use_default_colors (); my $colors = ""; my (@ansi_tab) = qw/0 4 2 6 1 5 3 7/; for (my $i = 1; $i < $COLOR_PAIRS; $i++) { init_pair ($i, $ansi_tab[$i & 7], $i <= 7 ? -1 : $ansi_tab[$i >> 3]); } } $win->attron (A_NORMAL); $stdiowatcher = AnyEvent->io (fh => \*STDIN, poll => "r", cb => sub { input; }); } sub end { endwin; } sub print_colors { my $l = []; for (my $i = 0; $i <= 256; $i++) { push @$l, $i, (sprintf "[%3d]", $i); if (($i + 1) % 8 == 0) { printline ($current_buffer => $l); $l = []; } } printline ($current_buffer => $l); } #printline ("TESTE!!!"); 1;