Net-IRC3/samples/CursesChatMainwindow.pm

package CursesChatMainwindow;
use strict;
use Curses;
use Term::ReadKey;
use Exporter;
our @ISA = qw/Exporter/;
our @EXPORT = qw/printline select_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 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 {
         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;
Revision:	1.1
Committed:	Wed Dec 6 23:08:51 2006 UTC (19 years, 10 months ago) by elmex
Branch:	MAIN
Log Message:	refactored the main gui for the curses client. input line and the main window work now finally, even scrolling with page up and page down works now.
#	User	Rev	Content
1	elmex	1.1	package CursesChatMainwindow;
2			use strict;
3			use Curses;
4			use Term::ReadKey;
5			use Exporter;
6			our @ISA = qw/Exporter/;
7			our @EXPORT = qw/printline select_buffer/;
8
9			our $HEIGHT;
10			our $WIDTH;
11			our $MAINWIN;
12			our $stdiowatcher;
13
14			our $current_buffer_scroll = 0;
15			our $current_buffer = "status";
16			our $winbuffers = {};
17
18			our $input_cb = sub {};
19
20			our @history;
21			our $inputbuffer;
22			our $inputoffset = 0;
23			our $cursor = 0;
24			our $statusline;
25
26			$SIG{WINCH} = sub {
27			my ($wc, $hc, $wpx, $hpx) = GetTerminalSize ();
28			resizeterm ($hc, $wc);
29			$MAINWIN->resize ($hc, $wc);
30			$HEIGHT = $hc;
31			$WIDTH = $wc;
32			$MAINWIN->erase;
33			refresh ();
34			};
35
36			sub color2attr {
37			my $c = $_[0];
38			my $attr;
39			if ($c <= 63) {
40			$attr = COLOR_PAIR($c);
41			} elsif ($c <= 127) {
42			$c -= 64;
43			$attr = COLOR_PAIR($c) \| A_BOLD;
44			} elsif ($c <= 191) {
45			$c -= 128;
46			$attr = COLOR_PAIR($c) \| A_UNDERLINE;
47			} else {
48			$c -= 192;
49			$attr = COLOR_PAIR($c) \| A_UNDERLINE \| A_BOLD;
50			}
51			$attr
52			}
53
54			sub register_input_cb {
55			my ($cb) = @_;
56			$input_cb = $cb;
57			}
58
59			sub _draw_attr_line_at {
60			my ($line, $attrline) = @_;
61
62			my @lcont = @$attrline;
63			my $li = 0;
64
65			while (@lcont > 0) {
66			my ($color, $str) = (shift @lcont, shift @lcont);
67
68			$MAINWIN->attron (color2attr ($color));
69
70			my $sl = length $str;
71			if (($li + $sl) > $WIDTH) {
72			$sl = $WIDTH - $li;
73			last if $sl < 0;
74			}
75
76			$MAINWIN->addnstr ($line, $li, (substr $str, 0, $sl), $sl);
77
78			$li += $sl;
79
80			$MAINWIN->attroff (color2attr ($color));
81			}
82			}
83
84			sub clog {
85			open LOG, ">>/tmp/debuglog";
86			print LOG @_;
87			close LOG;
88			}
89
90			sub wrap_attr_lines {
91			my ($width, @lines) = @_;
92
93			my @outlines;
94
95			for my $line (@lines) {
96			my $wrap_padding = 0;
97			my @cline = @$line;
98			my @oline;
99
100			my $outc = 0;
101
102			while (@cline) {
103			my ($color, $str) = (shift @cline, shift @cline);
104			if ($color =~ m/^p\s(\d+)\s$/) {
105			$wrap_padding = $1;
106			($color, $str) = ($str, shift @cline);
107			}
108
109			my $strlen = length $str;
110
111			if (($outc + $strlen) > $width) {
112			my $thisl = $width - $outc;
113			push @oline, ($color, substr $str, 0, $thisl);
114			push @outlines, [@oline];
115			@oline = ();
116			unshift @cline, ($color, substr $str, $thisl);
117			if ($wrap_padding && $wrap_padding < $width) {
118			unshift @cline, (0, ' ' x $wrap_padding);
119			}
120			$outc = 0;
121			} else {
122			push @oline, ($color, $str);
123			$outc += $strlen;
124			}
125			}
126
127			push @outlines, [@oline];
128			}
129
130			# my $i = 0;
131			# for my $line (@outlines) {
132			# clog ("LINE$i: ".join ('\|',@$line)."\n");
133			# $i++;
134			# }
135
136			@outlines;
137			}
138
139			sub refresh_lines {
140			$MAINWIN->erase;
141
142			my @revwin = @{$winbuffers->{$current_buffer} \|\| []};
143			if (scalar @revwin > ($HEIGHT + $current_buffer)) {
144			(@revwin) = splice @revwin, -$HEIGHT;
145			}
146
147			my (@out_lines) = reverse wrap_attr_lines ($WIDTH, @revwin);
148
149			if ($current_buffer_scroll > 0) {
150			if ($current_buffer_scroll > scalar (@out_lines)) {
151			$current_buffer_scroll = scalar (@out_lines);
152			}
153			@out_lines = splice @out_lines, $current_buffer_scroll;
154			clog ("SPLICE$current_buffer_scroll [".(scalar @out_lines)."]\n");
155			}
156
157			_draw_attr_line_at ($HEIGHT - 2, $statusline \|\| [0, 'nothing']);
158
159			my $line = $HEIGHT - 3;
160			while ($line >= 0) {
161			my $l = shift @out_lines;
162			last unless defined $l;
163			_draw_attr_line_at ($line--, $l);
164			}
165			}
166
167			sub refresh {
168			my ($onlyinput) = @_;
169
170			refresh_lines unless $onlyinput;
171
172			$MAINWIN->move ($HEIGHT - 1, 0);
173			$MAINWIN->clrtoeol ();
174
175			my $padding = $WIDTH - int ($WIDTH / 1.2);
176
177			if ($cursor >= ($WIDTH - $padding)) {
178			my $iobuf = $inputbuffer;
179			my $il = length $iobuf;
180			my $ncursor = $cursor;
181			my $lcursor = $cursor - int ($WIDTH / 1.2);
182			$ncursor -= $lcursor;
183			substr $iobuf, 0, $lcursor, '';
184			$MAINWIN->addstr ($HEIGHT - 1, 0, (substr $iobuf, 0, $WIDTH));
185			$MAINWIN->move ($HEIGHT - 1, $ncursor);
186			} else {
187			$MAINWIN->addstr ($HEIGHT - 1, 0, (substr $inputbuffer, 0, $WIDTH));
188			$MAINWIN->move ($HEIGHT - 1, $cursor);
189			}
190			$MAINWIN->refresh;
191			}
192
193			sub select_buffer {
194			$current_buffer = $_[0];
195			$current_buffer_scroll = 0;
196			refresh ();
197			}
198
199			sub printline {
200			if ($_[0] eq 'statusline') {
201			$statusline = $_[1];
202			} else {
203			push @{$winbuffers->{(defined $_[0] ? $_[0] : "status")}}, $_[1];
204			}
205			refresh ();
206			}
207
208			sub input {
209			my $c = $MAINWIN->getch;
210			if ($c == KEY_BACKSPACE) {
211			if ($cursor > 0) {
212			substr $inputbuffer, --$cursor, 1, '';
213			}
214			} elsif ($c == KEY_DC) {
215			substr $inputbuffer, $cursor, 1, '';
216			} elsif ($c == KEY_LEFT) {
217			$cursor-- if $cursor > 0;
218			} elsif ($c == KEY_RIGHT) {
219			$cursor++ if (($cursor + 1) <= (length $inputbuffer));
220			} elsif ($c == KEY_PPAGE) {
221			$current_buffer_scroll += int ($HEIGHT / 2);
222			} elsif ($c == KEY_NPAGE) {
223			$current_buffer_scroll -= int ($HEIGHT / 2);
224			$current_buffer_scroll = 0 if $current_buffer_scroll < 0;
225			} elsif ($c eq "\n") {
226			push @history, $inputbuffer;
227			$input_cb->($inputbuffer);
228			$inputbuffer = "";
229			$cursor = 0;
230			} else {
231			if ($c > 255) {
232			printline (status => [0, "SPECIAL[$c]"]);
233			} else {
234			substr $inputbuffer, $cursor++, 0, $c;
235			}
236			}
237			refresh ();
238			}
239
240			sub init {
241			my $win = $MAINWIN = Curses->new;
242			cbreak;
243			noecho;
244			clear;
245			$win->keypad (1);
246			($HEIGHT, $WIDTH) = ($LINES, $COLS);
247			if (has_colors ()) {
248			start_color ();
249			use_default_colors ();
250			my $colors = "";
251			my (@ansi_tab) = qw/0 4 2 6 1 5 3 7/;
252			for (my $i = 1; $i < $COLOR_PAIRS; $i++) {
253			init_pair ($i, $ansi_tab[$i & 7], $i <= 7 ? -1 : $ansi_tab[$i >> 3]);
254			}
255			}
256			$win->attron (A_NORMAL);
257			$stdiowatcher = AnyEvent->io (fh => \*STDIN, poll => "r", cb => sub {
258			input;
259			});
260			}
261
262			sub end {
263			endwin;
264			}
265
266			sub print_colors {
267			my $l = [];
268			for (my $i = 0; $i <= 256; $i++) {
269			push @$l, $i, (sprintf "[%3d]", $i);
270			if (($i + 1) % 8 == 0) {
271			printline ($current_buffer => $l);
272			$l = [];
273			}
274			}
275			printline ($current_buffer => $l);
276			}
277			#printline ("TESTE!!!");
278
279			1;