Index: CHANGES.RSE =================================================================== RCS file: CHANGES.RSE diff -N CHANGES.RSE --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ CHANGES.RSE 28 Mar 2003 08:24:58 -0000 1.5 @@ -0,0 +1,19 @@ + + The following changes were made by Ralf S. Engelschall + to the excellent Curses::UI 0.72 by Maurice Makaay . + + o Make sure that Curses::UI::Listbox draws the selected values in bold + also under "multi" and "radio" options to be consistent in look & + feel with the standard list box. + + o Add support for root->overlapping(1) (default) and + root->overlapping(0) to optimize the redrawing by reducing to + the old and new focused widgets. The default is still to redraw + everything which is necessary to support overlapping windows. + + o Add -reverse option to Curses::UI::TextEditor. + + o Add color support. + + o Fix reverse rendering for Label demo in demo-widgets. + Index: lib/Curses/UI.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI.pm,v retrieving revision 1.1.1.2 retrieving revision 1.4 diff -u -d -u -d -r1.1.1.2 -r1.4 --- lib/Curses/UI.pm 28 Mar 2003 08:22:34 -0000 1.1.1.2 +++ lib/Curses/UI.pm 28 Mar 2003 08:24:58 -0000 1.4 @@ -67,6 +67,8 @@ -debug => undef, # Turn on debugging mode? -language => undef, # Which language to use? -mouse_support => 1, # Do we want mouse support + -overlapping => 1, # Whether overlapping widgets are supported + -colors => 0, # Whether colors are used %userargs, @@ -123,6 +125,8 @@ sub clear_on_exit(;$) { shift()->accessor('-clear_on_exit', shift()) } sub cursor_mode(;$) { shift()->accessor('-cursor_mode', shift()) } sub lang(;$) { shift()->accessor('-language_object', shift()) } +sub overlapping(;$) { shift()->accessor('-overlapping', shift()) } +sub colors(;$) { shift()->accessor('-colors', shift()) } # TODO: document sub debug(;$) @@ -133,6 +137,61 @@ } # ---------------------------------------------------------------------- +# Color support +# ---------------------------------------------------------------------- + +$Curses::UI::colorpairs = 0; +$Curses::UI::colorpair = {}; + +sub colorpair ($$;$$) +{ + my $this = shift; + my ($name, $fg, $bg) = @_; + my $colors_name2num = { + 'black' => COLOR_BLACK, + 'red' => COLOR_RED, + 'green' => COLOR_GREEN, + 'yellow' => COLOR_YELLOW, + 'blue' => COLOR_BLUE, + 'magenta' => COLOR_MAGENTA, + 'cyan' => COLOR_CYAN, + 'white' => COLOR_WHITE + }; + + if (not $this->{-colors}) { + return 0; + } + if (not defined($fg) and not defined($bg)) { + return ($Curses::UI::colorpair->{$name} || 0); + } + else { + my $n = $Curses::UI::colorpair->{$name}; + if (not defined($n)) { + $Curses::UI::colorpairs++; + $n = $Curses::UI::colorpairs; + } + $fg = $colors_name2num->{$fg} || 'default'; + if ($fg eq 'default') { + my ($fg_d, $bg_d) = (0, 0); + pair_content(0, $fg_d, $bg_d); + $fg = $fg_d; + } + $bg = $colors_name2num->{$bg} || 'default'; + if ($bg eq 'default') { + my ($fg_d, $bg_d) = (0, 0); + pair_content(0, $fg_d, $bg_d); + $bg = $bg_d; + } + init_pair($n, $fg, $bg); + if ($name eq 'default') { + assume_default_colors($fg, $bg); + } + $Curses::UI::colorpair->{$name} = $n; + return $n; + } +} + +# ---------------------------------------------------------------------- # Window resizing support # ---------------------------------------------------------------------- @@ -148,6 +207,23 @@ initscr(); noecho(); raw(); + + # Color support + if ($this->{-colors}) { + if (has_colors()) { + start_color(); + #my $bg = -1; + #use_default_colors(); + my $bg = COLOR_BLACK; + assume_default_colors(COLOR_WHITE, $bg); + $Curses::UI::colorpair->{"default"} = 0; + $Curses::UI::colorpairs = 1; + $this->colorpair('selected', 'default', 'default'); + } + else { + $this->{-colors} = 0; + } + } # Mouse events if possible my $old = 0; Index: lib/Curses/UI/Label.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Label.pm,v retrieving revision 1.1.1.2 retrieving revision 1.3 diff -u -d -u -d -r1.1.1.2 -r1.3 --- lib/Curses/UI/Label.pm 28 Mar 2003 08:22:35 -0000 1.1.1.2 +++ lib/Curses/UI/Label.pm 28 Mar 2003 08:24:58 -0000 1.3 @@ -51,6 +51,7 @@ -dim => 0, -blink => 0, -paddingspaces => 0, # Pad text with spaces? + -colorpair => undef, # Color-pair attribute %userargs, @@ -104,6 +105,7 @@ sub underline ($;$) { shift()->set_attribute('-underline', shift()) } sub dim ($;$) { shift()->set_attribute('-dim', shift()) } sub blink ($;$) { shift()->set_attribute('-blink', shift()) } +sub colorpair ($;$) { shift()->set_attribute('-colorpair', shift()) } sub set_attribute($$;) { @@ -183,6 +185,7 @@ $this->{-canvasscr}->attron(A_UNDERLINE) if $this->{-underline}; $this->{-canvasscr}->attron(A_BLINK) if $this->{-blink}; $this->{-canvasscr}->attron(A_DIM) if $this->{-dim}; + $this->{-canvasscr}->attron(COLOR_PAIR($this->root->colorpair($this->{-colorpair}))) if $this->{-colorpair}; # Draw the text. Clip it if it is too long. my $ypos = 0; Index: lib/Curses/UI/Listbox.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Listbox.pm,v retrieving revision 1.1.1.2 retrieving revision 1.3 diff -u -d -u -d -r1.1.1.2 -r1.3 --- lib/Curses/UI/Listbox.pm 28 Mar 2003 08:22:35 -0000 1.1.1.2 +++ lib/Curses/UI/Listbox.pm 28 Mar 2003 08:24:58 -0000 1.3 @@ -306,10 +306,12 @@ } # Show selected element bold. - if (not $this->{-multi} and - not $this->{-radio} and - defined $this->{-selected} and - $this->{-selected} == $i) { + if ( ( not $this->{-multi} + and defined $this->{-selected} + and $this->{-selected} == $i) + or ( $this->{-multi} + and defined $this->{-selected} + and $this->{-selected}->{$i}) ) { $this->{-canvasscr}->attron(A_BOLD); } Index: lib/Curses/UI/TextEditor.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/TextEditor.pm,v retrieving revision 1.1.1.2 retrieving revision 1.3 diff -u -d -u -d -r1.1.1.2 -r1.3 --- lib/Curses/UI/TextEditor.pm 28 Mar 2003 08:22:36 -0000 1.1.1.2 +++ lib/Curses/UI/TextEditor.pm 28 Mar 2003 08:24:58 -0000 1.3 @@ -151,6 +151,7 @@ -vscrollbar => 0, # show vertical scrollbar -hscrollbar => 0, # show horizontal scrollbar -readonly => 0, # only used as viewer? + -reverse => 0, # show in reverse # Single line options -password => undef, # masquerade chars with given char @@ -451,9 +452,10 @@ # Turn on underlines and fill the screen with lines # if neccessary. - if ($this->{-showlines}) + if ($this->{-showlines} or $this->{-reverse}) { - $this->{-canvasscr}->attron(A_UNDERLINE); + $this->{-canvasscr}->attron(A_UNDERLINE) if ($this->{-showlines});; + $this->{-canvasscr}->attron(A_REVERSE) if ($this->{-reverse}); for my $y (0..$this->canvasheight-1) { $this->{-canvasscr}->addstr($y, 0, " "x($this->canvaswidth)); } @@ -464,9 +466,11 @@ { if (defined $this->{-search_highlight} and $this->{-search_highlight} == ($id+$this->{-yscrpos})) { - $this->{-canvasscr}->attron(A_REVERSE); + $this->{-canvasscr}->attron(A_REVERSE) if (not $this->{-reverse}); + $this->{-canvasscr}->attroff(A_REVERSE) if ($this->{-reverse}); } else { - $this->{-canvasscr}->attroff(A_REVERSE); + $this->{-canvasscr}->attroff(A_REVERSE) if (not $this->{-reverse}); + $this->{-canvasscr}->attron(A_REVERSE) if ($this->{-reverse}); } my $l = $this->{-scr_lines}->[$id + $this->{-yscrpos}]; @@ -560,6 +564,7 @@ } $this->{-canvasscr}->attroff(A_UNDERLINE) if $this->{-showlines}; + $this->{-canvasscr}->attroff(A_REVERSE) if $this->{-reverse}; $this->{-canvasscr}->noutrefresh(); doupdate() unless $no_doupdate; return $this; Index: lib/Curses/UI/Widget.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Widget.pm,v retrieving revision 1.1.1.2 retrieving revision 1.3 diff -u -d -u -d -r1.1.1.2 -r1.3 --- lib/Curses/UI/Widget.pm 28 Mar 2003 08:22:35 -0000 1.1.1.2 +++ lib/Curses/UI/Widget.pm 28 Mar 2003 08:24:58 -0000 1.3 @@ -461,7 +461,7 @@ my $parent = $this->parent; $parent->focus($this) if defined $parent; - $this->draw(1); + $this->draw(1) if ($this->root->overlapping); return $this; } @@ -513,6 +513,7 @@ if ($this->{-sbborder}) # Square bracket ([,]) border { $this->{-borderscr}->attron(A_BOLD) if $this->{-focus}; + $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus}; my $offset = 1; $offset++ if $this->{-vscrollbar}; for my $y (0 .. $this->{-sh}-1) @@ -522,10 +523,12 @@ $this->{-borderscr}->addstr($rel_y, $this->{-bw}-$offset, ']'); } $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus}; + $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus}; } elsif ($this->{-border}) # Normal border { $this->{-borderscr}->attron(A_BOLD) if $this->{-focus}; + $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus}; if ($this->root->compat) { $this->{-borderscr}->border( '|','|','-','-', @@ -535,6 +538,7 @@ $this->{-borderscr}->box(ACS_VLINE, ACS_HLINE); } $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus}; + $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus}; # Draw a title if needed. if (defined $this->{-title}) @@ -614,6 +618,7 @@ # Draw the base of the scrollbar, in case # there is no border. $this->{-borderscr}->attron(A_BOLD) if $this->{-focus}; + $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus}; $this->{-borderscr}->move($ypos_min, $xpos); $this->{-borderscr}->vline(ACS_VLINE,$scrlen); if ($this->root->compat) { @@ -622,6 +627,7 @@ $this->{-borderscr}->vline(ACS_VLINE,$scrlen); } $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus}; + $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus}; # Should an active region be drawn? my $scroll_active = ($this->{-vscrolllen} > $scrlen); @@ -679,6 +685,7 @@ # Draw the base of the scrollbar, in case # there is no border. $this->{-borderscr}->attron(A_BOLD) if $this->{-focus}; + $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus}; $this->{-borderscr}->move($ypos, $xpos_min); if ($this->root->compat) { $this->{-borderscr}->hline('-',$scrlen); @@ -686,6 +693,7 @@ $this->{-borderscr}->hline(ACS_HLINE,$scrlen); } $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus}; + $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus}; # Should an active region be drawn? my $scroll_active = ($this->{-hscrolllen} > $scrlen); @@ -945,6 +953,8 @@ my $show_cursor = $this->{-nocursor} ? 0 : 1; $this->root->cursor_mode($show_cursor); + $this->draw(1) if (not $this->root->overlapping); + return $this; } @@ -953,6 +963,7 @@ my $this = shift; $this->{-focus} = 0; $this->run_event('-onblur'); + $this->draw(1) if (not $this->root->overlapping); return $this; } Index: examples/demo-widgets =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/examples/demo-widgets,v retrieving revision 1.1.1.1 retrieving revision 1.4 diff -u -d -u -d -r1.1.1.1 -r1.4 --- examples/demo-widgets 20 Nov 2002 15:00:36 -0000 1.1.1.1 +++ examples/demo-widgets 21 Nov 2002 20:14:59 -0000 1.4 @@ -1,5 +1,10 @@ -#!/usr/bin/perl -w +#!/usr/lpkg/bin/perl -w use strict; +use lib "../lib"; + +# make KEY_BTAB (shift-tab) working in XTerm +# and also at the same time enable colors +$ENV{TERM} = "xterm-vt220" if ($ENV{TERM} eq 'xterm'); my $debug = 0; if (@ARGV and $ARGV[0] eq '-d') { @@ -19,7 +24,10 @@ my $cui = new Curses::UI ( -clear_on_exit => 1, -debug => $debug, + -colors => 1, ); +$cui->colorpair('selected', 'red', 'default'); +$cui->colorpair('white-on-red', 'white', 'red'); # Demo index my $current_demo = 1; @@ -147,9 +155,10 @@ $w{1}->add(undef,'Label',-text=>"dim font",-y=>5,-dim=>1 ); $w{1}->add(undef,'Label',-text=>"bold font",-y=>7,-bold=>1 ); -$w{1}->add(undef,'Label',-text=>"reversed font",-y=>9,-reversed => 1 ); +$w{1}->add(undef,'Label',-text=>"reversed font",-y=>9,-reverse => 1 ); $w{1}->add(undef,'Label',-text=>"underlined font",-x=>15,-y=>5,-underline=>1 ); $w{1}->add(undef,'Label',-text=>"blinking font",-x=>15,-y=>7,-blink=>1 ); +$w{1}->add(undef,'Label',-text=>"colorized font",-x=>15,-y=>9,-colorpair => 'white-on-red' ); # ---------------------------------------------------------------------- # Buttons demo