"Fossies" - the Fresh Open Source Software Archive 
Member "xterm-379/vttests/88colors2.pl" (11 Oct 2022, 6797 Bytes) of package /linux/misc/xterm-379.tgz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "88colors2.pl" see the
Fossies "Dox" file reference documentation and the last
Fossies "Diffs" side-by-side code changes report:
373_vs_374.
1 #!/usr/bin/env perl
2 # $XTermId: 88colors2.pl,v 1.22 2022/10/11 00:05:34 tom Exp $
3 # -----------------------------------------------------------------------------
4 # this file is part of xterm
5 #
6 # Copyright 1999-2021,2022 by Thomas E. Dickey
7 # Copyright 1999 by Steve Wall
8 #
9 # All Rights Reserved
10 #
11 # Permission is hereby granted, free of charge, to any person obtaining a
12 # copy of this software and associated documentation files (the
13 # "Software"), to deal in the Software without restriction, including
14 # without limitation the rights to use, copy, modify, merge, publish,
15 # distribute, sublicense, and/or sell copies of the Software, and to
16 # permit persons to whom the Software is furnished to do so, subject to
17 # the following conditions:
18 #
19 # The above copyright notice and this permission notice shall be included
20 # in all copies or substantial portions of the Software.
21 #
22 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
23 # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
24 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
25 # IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
26 # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
27 # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
28 # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
29 #
30 # Except as contained in this notice, the name(s) of the above copyright
31 # holders shall not be used in advertising or otherwise to promote the
32 # sale, use or other dealings in this Software without prior written
33 # authorization.
34 # -----------------------------------------------------------------------------
35 #
36 # Adapted from 256colors2.pl
37
38 # If -s is not given, use the resources for colors 0-15 - usually more-or-less
39 # a reproduction of the standard ANSI colors, but possibly more pleasing
40 # shades.
41
42 use strict;
43 use warnings;
44
45 use Getopt::Std;
46 use Encode 'encode_utf8';
47
48 our ( $opt_8, $opt_c, $opt_C, $opt_d, $opt_h, $opt_q, $opt_r, $opt_s, $opt_u );
49
50 $Getopt::Std::STANDARD_HELP_VERSION = 1;
51 &getopts('8cCdhqrsu') || die("Usage: $0 [options]");
52 die(
53 "Usage: $0 [options]\n
54 Options:
55 -8 use 8-bit controls
56 -c use colons for separating parameter values in SGR 38/48
57 -C like -c, but allow semicolon plus colon
58 -d use rgb values rather than palette index
59 -h display this message
60 -q quieter output by merging all palette initialization
61 -r display the reverse of the usual palette
62 -s modify system colors, i.e., 0..15
63 -u use UTF-8 when emitting 8-bit controls
64 "
65 ) if ($opt_h);
66
67 our $cube = 4;
68 our (@steps);
69 our ( $red, $green, $blue );
70 our ( $gray, $level, $color );
71 our ( $csi, $osc, $sep, $sep2, $st );
72
73 our @rgb;
74
75 sub map_cube($) {
76 my $value = $_[0];
77 $value = ( 3 - $value ) if defined($opt_r);
78 return $value;
79 }
80
81 sub map_gray($) {
82 my $value = $_[0];
83 $value = ( 7 - $value ) if defined($opt_r);
84 return $value;
85 }
86
87 sub define_color($$$$) {
88 my $index = $_[0];
89 my $r = $_[1];
90 my $g = $_[2];
91 my $b = $_[3];
92
93 printf( "%s4", $osc ) unless ($opt_q);
94 printf( ";%d;rgb:%2.2x/%2.2x/%2.2x", $index, $r, $g, $b );
95 printf( "%s", $st ) unless ($opt_q);
96
97 $rgb[$index] = sprintf "%d%s%d%s%d", $r, $sep, $g, $sep, $b;
98 }
99
100 sub select_color($) {
101 my $index = $_[0];
102 if ( $opt_d and defined( $rgb[$index] ) ) {
103 printf "%s48%s2%s%sm ", $csi, $sep, $sep2, $rgb[$index];
104 }
105 else {
106 printf "%s48%s5%s%sm ", $csi, $sep, $sep2, $index;
107 }
108 }
109
110 sub system_color($$$$) {
111 my $color = shift;
112 my $red = shift;
113 my $green = shift;
114 my $blue = shift;
115 &define_color( 15 - $color, $red, $green, $blue ) if ($opt_r);
116 &define_color( $color, $red, $green, $blue ) unless ($opt_r);
117 }
118
119 if ($opt_8) {
120 $csi = "\x9b";
121 $osc = "\x9d";
122 $st = "\x9c";
123 }
124 else {
125 $csi = "\x1b[";
126 $osc = "\x1b]";
127 $st = "\x1b\\";
128 }
129
130 if ($opt_c) {
131 $sep = ":";
132 }
133 else {
134 $sep = ";";
135 }
136 $sep2 = $sep;
137
138 if ($opt_C) {
139 $sep = ";";
140 $sep2 = ":";
141 }
142
143 if ( $opt_8 and $opt_u ) {
144 if ( open( FP, "locale 2>/dev/null |" ) ) {
145 my (@locale) = <FP>;
146 chomp @locale;
147 close(FP);
148 for my $n ( 0 .. $#locale ) {
149 if ( $locale[$n] =~ /^LC_CTYPE=/ ) {
150 binmode( STDOUT, ":utf8" ) if ( $locale[$n] =~ /utf.?8/i );
151 last;
152 }
153 }
154 }
155 }
156
157 printf( "%s4", $osc ) if ($opt_q);
158
159 if ($opt_s) {
160 &system_color( 0, 0, 0, 0 );
161 &system_color( 1, 205, 0, 0 );
162 &system_color( 2, 0, 205, 0 );
163 &system_color( 3, 205, 205, 0 );
164 &system_color( 4, 0, 0, 238 );
165 &system_color( 5, 205, 0, 205 );
166 &system_color( 6, 0, 205, 205 );
167 &system_color( 7, 229, 229, 229 );
168 &system_color( 8, 127, 127, 127 );
169 &system_color( 9, 255, 0, 0 );
170 &system_color( 10, 0, 255, 0 );
171 &system_color( 11, 255, 255, 0 );
172 &system_color( 12, 92, 92, 255 );
173 &system_color( 13, 255, 0, 255 );
174 &system_color( 14, 0, 255, 255 );
175 &system_color( 15, 255, 255, 255 );
176 }
177
178 # colors 16-79 are a 4x4x4 color cube
179 @steps = ( 0, 139, 205, 255 );
180 for ( $red = 0 ; $red < $cube ; $red++ ) {
181 for ( $green = 0 ; $green < $cube ; $green++ ) {
182 for ( $blue = 0 ; $blue < $cube ; $blue++ ) {
183 &define_color(
184 16 + ( map_cube($red) * $cube * $cube ) +
185 ( map_cube($green) * $cube ) +
186 map_cube($blue),
187 int( $steps[$red] ),
188 int( $steps[$green] ),
189 int( $steps[$blue] )
190 );
191 }
192 }
193 }
194
195 # colors 80-87 are a grayscale ramp, intentionally leaving out
196 # black and white
197 for ( $gray = 0 ; $gray < 8 ; $gray++ ) {
198 $level = ( map_gray($gray) * 23.18181818 ) + 46.36363636;
199 if ( $gray > 0 ) { $level += 23.18181818; }
200 &define_color( 80 + $gray, int($level), int($level), int($level) );
201 }
202 printf( "%s", $st ) if ($opt_q);
203
204 # display the colors
205
206 # first the system ones:
207 print "System colors:\n";
208 for ( $color = 0 ; $color < 8 ; $color++ ) {
209 &select_color($color);
210 }
211 printf "%s0m\n", $csi;
212 for ( $color = 8 ; $color < 16 ; $color++ ) {
213 &select_color($color);
214 }
215 printf "%s0m\n\n", $csi;
216
217 # now the color cube
218 print "Color cube, ${cube}x${cube}x${cube}:\n";
219 for ( $green = 0 ; $green < $cube ; $green++ ) {
220 for ( $red = 0 ; $red < $cube ; $red++ ) {
221 for ( $blue = 0 ; $blue < $cube ; $blue++ ) {
222 $color = 16 + ( $red * $cube * $cube ) + ( $green * $cube ) + $blue;
223 &select_color($color);
224 }
225 printf "%s0m ", $csi;
226 }
227 print "\n";
228 }
229
230 # now the grayscale ramp
231 print "Grayscale ramp:\n";
232 for ( $color = 80 ; $color < 88 ; $color++ ) {
233 &select_color($color);
234 }
235 printf "%s0m\n", $csi;