/usr/share/perl5/Curses/UI/Color.pm is in libcurses-ui-perl 0.9609-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 | # ----------------------------------------------------------------------
# Curses::UI::Color
#
# (c) 2003 by Marcus Thiesen. All rights reserved.
# This file is part of Curses::UI. Curses::UI is free software.
# You can redistribute it and/or modify it under the same terms
# as perl itself.
#
# e-mail: marcus@cpan.thiesenweb.de
# ----------------------------------------------------------------------
package Curses::UI::Color;
use Curses;
use Curses::UI::Common;
use strict;
use vars qw(
@ISA
$VERSION
);
$VERSION = "0.01";
@ISA = qw(
Curses::UI::Common
);
sub new {
my $class = shift;
my %userargs = @_;
keys_to_lowercase(\%userargs);
my %args = (
-default_colors => 1,
%userargs,
);
if ( $args{-default_colors} ) {
use_default_colors();
}
start_color();
my $this = bless { %args }, $class;
$this->{cmap} = {
black => COLOR_BLACK,
red => COLOR_RED,
green => COLOR_GREEN,
yellow => COLOR_YELLOW,
blue => COLOR_BLUE,
magenta => COLOR_MAGENTA,
cyan => COLOR_CYAN,
white => COLOR_WHITE,
};
$this->{pmap} = {};
$this->{pcount} = 0;
$this->{ccount} = 7;
return $this;
}
sub get_color_pair {
my $this = shift;
my $fg = shift;
my $bg = shift;
return unless defined $fg;
return unless defined $bg;
my $fgn = $this->{cmap}->{"$fg"};
my $bgn = $this->{cmap}->{"$bg"};
$fgn = -1 unless defined $fgn;
$bgn = -1 unless defined $bgn;
if ($this->{pmap}->{"$fg.$bg"}) {
return $this->{pmap}->{"$fg.$bg"};
} else {
$this->{pcount}++;
init_pair($this->{pcount}, $fgn, $bgn);
$this->{pmap}->{"$fg.$bg"} = $this->{pcount};
return $this->{pcount};
}
}
sub get_colors {
my $this = shift;
return keys %{$this->{cmap}};
}
sub colors {
return $Curses::UI::color_support;
}
sub define_color {
my $this = shift;
my $name = shift;
my ($r, $g, $b) = @_;
return unless $r < 1000;
return unless $g < 1000;
return unless $b < 1000;
return unless $r > 0;
return unless $g > 0;
return unless $b > 0;
init_color($this->{ccount}, $r, $g, $b);
$this->{cmap}->{$name} = $this->{ccount};
$this->{ccount}++;
return 1;
}
1;
=pod
=head1 NAME
Curses::UI::Color - Color support module
=head1 WARNING
This is a development version. As I do not expect to change
the interface during this time it may happen that the color
behaviour (e.g. to what extend color is drawn in a window)
may change or even the colors themselves. If you want something
stable, use -color_support => 0 , but you won't get those fency
colors then :-)
=head1 DESCRIPTION
This module provides all functions related to color support in
Curses::UI. The color support was implemented without disturbing
old applications, they will look as they used to do. Only if you
enable color support explicitly and it is available on your terminal
the color functions will have an effect.
=head1 SYNOPSIS
my $cui = new Curses::UI(-color_support => 1,
-clear_on_exit => 0);
my $mainw = $cui->add('screen', 'Window');
$mainw->add('l','Label', -bg => "white",
-fg => "blue",
-text => "Colored Label");
=head1 METHODS
=over 4
=item * B<new> (-default-colors => BOOLEAN)
Creates a new Curses::UI::Color object, the option
default colors define if the use_default_colors function
of Curses is used. See L<Curses> for that.
=item * B<get_colors> ( )
Returns all in this object defined colors as an array
=item * B<colors> ( )
Is true if color support is enabled.
=item * B<define_color> ( NAME, R, G, B )
This function defines a new color in the Color object. The
RGB values can be between 0 and 1000. Existing colors can
be redefined.
=back
=head1 USAGE
Curses::UI has 7 predefined colors:
black
red
green
yellow
blue
magenta
cyan
white
Curses::UI with color support also defines some new options:
-fg -bg for general foreground and background color.
-tfg -tbg for widget title fg and bg color
-bfg -bbg for widget border fg and bg color
-sfg -sbg for scrollbar fg and bg color
Every widget has has a runtime setter:
set_color_fg ( COLOR )
set_colof_bg ( COLOR )
set_color_tfg ( COLOR )
set_colof_tbg ( COLOR )
set_color_bfg ( COLOR )
set_colof_bbg ( COLOR )
set_color_sfg ( COLOR )
set_colof_sbg ( COLOR )
Mostly every widget has a -fg and -bg option to set the foreground
and background color using the above color names. Own colors can be
defined using the B<define_color> method. Every widget that
supports color by now has also two functions B<set_color_fg> and
B<set_color_bg> to set or change the color at runtime.
Widgets with borders and scrollbars can use -bfg and -bbg to set the
foreground and background color of the border or the -sfg and -sbg
option to set the colors of the scrollbar.
Widgets with titles can set the -tfg and -tbg option to define
the title foreground and background color.
Check also the examples/color_editor for seeing what is possible
at the moment.
=head1 SEE ALSO
L<Curses::UI>
=head1 AUTHOR
Copyright (c) 2003 Marcus Thiesen. All rights reserved.
Maintained by Marcus Thiesen (marcus@cpan.thiesenweb.de)
This package is free software and is provided "as is" without express
or implied warranty. It may be used, redistributed and/or modified
under the same terms as perl itself.
|