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