"Fossies" - the Fresh Open Source Software Archive 
Member "xterm-379/vttests/closest-rgb.pl" (13 Dec 2020, 6858 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 "closest-rgb.pl" see the
Fossies "Dox" file reference documentation.
1 #!/usr/bin/env perl
2 # $XTermId: closest-rgb.pl,v 1.12 2020/12/13 15:07:02 tom Exp $
3 # -----------------------------------------------------------------------------
4 # this file is part of xterm
5 #
6 # Copyright 2017-2018,2020 by Thomas E. Dickey
7 #
8 # All Rights Reserved
9 #
10 # Permission is hereby granted, free of charge, to any person obtaining a
11 # copy of this software and associated documentation files (the
12 # "Software"), to deal in the Software without restriction, including
13 # without limitation the rights to use, copy, modify, merge, publish,
14 # distribute, sublicense, and/or sell copies of the Software, and to
15 # permit persons to whom the Software is furnished to do so, subject to
16 # the following conditions:
17 #
18 # The above copyright notice and this permission notice shall be included
19 # in all copies or substantial portions of the Software.
20 #
21 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
22 # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
23 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
24 # IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
25 # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
26 # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
27 # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
28 #
29 # Except as contained in this notice, the name(s) of the above copyright
30 # holders shall not be used in advertising or otherwise to promote the
31 # sale, use or other dealings in this Software without prior written
32 # authorization.
33 # -----------------------------------------------------------------------------
34 # For a given RGB value, show its distance from xterm's 88/256-color
35 # models or alternatively against rgb.txt
36
37 use strict;
38 use warnings;
39
40 use Getopt::Std;
41
42 our $namedRGB = "/etc/X11/rgb.txt";
43 our @namedRGB;
44 our @xtermRGB;
45
46 our ( $opt_f, $opt_i, $opt_n );
47
48 sub main::HELP_MESSAGE() {
49 printf STDERR <<EOF
50 Usage: $0 [options]\n
51 Options:\n
52 -f FILE pathname for rgb.txt (default $namedRGB)
53 -i reverse comparison, look for rgb matches in xterm's palette
54 -n NUM number of colors in palette (default: 16)
55 EOF
56 ;
57 exit 1;
58 }
59
60 $Getopt::Std::STANDARD_HELP_VERSION = 1;
61 &getopts('f:in:') || &main::HELP_MESSAGE;
62 $opt_f = $namedRGB unless ($opt_f);
63 $opt_n = 16 unless ($opt_n);
64
65 sub value_of($) {
66 my $text = shift;
67 my $value = (
68 ( $text =~ /^0[0-7]*$/ ) ? ( oct $text )
69 : (
70 ( $text =~ /^\d+$/ ) ? $text
71 : hex $text
72 )
73 );
74 }
75
76 sub lookup($) {
77 my $value = shift;
78
79 chomp $value;
80 $value =~ s/^\s*//;
81 $value =~ s/\s*$//;
82
83 my $rgb = $value;
84 $rgb =~ s/^((\w+\s+){2,2}(\w+)).*/$1/;
85 my @rgb = split /\s+/, $rgb;
86
87 my $name = $value;
88 $name =~ s/^((\w+\s+){3,3})//;
89
90 my %result;
91 $result{R} = &value_of( $rgb[0] );
92 $result{G} = &value_of( $rgb[1] );
93 $result{B} = &value_of( $rgb[2] );
94 $result{NAME} = $name;
95 return \%result;
96 }
97
98 sub xterm16() {
99 my @result;
100 my $o = 0;
101 $result[ $o++ ] = &lookup("0 0 0 black");
102 $result[ $o++ ] = &lookup("205 0 0 red3");
103 $result[ $o++ ] = &lookup("0 205 0 green3");
104 $result[ $o++ ] = &lookup("205 205 0 yellow3");
105 $result[ $o++ ] = &lookup("0 0 238 blue2");
106 $result[ $o++ ] = &lookup("205 0 205 magenta3");
107 $result[ $o++ ] = &lookup("0 205 205 cyan3");
108 $result[ $o++ ] = &lookup("229 229 229 gray90");
109 $result[ $o++ ] = &lookup("127 127 127 gray50");
110 $result[ $o++ ] = &lookup("255 0 0 red");
111 $result[ $o++ ] = &lookup("0 255 0 green");
112 $result[ $o++ ] = &lookup("255 255 0 yellow");
113 $result[ $o++ ] = &lookup("0x5b 0x5c 0xff xterm blue");
114 $result[ $o++ ] = &lookup("255 0 255 magenta");
115 $result[ $o++ ] = &lookup("0 255 255 cyan");
116 $result[ $o++ ] = &lookup("255 255 255 white");
117 return @result;
118 }
119
120 sub xtermRGB($) {
121 my $base = shift;
122
123 my ( $cube, $cube1, $cube2 ) = $base #
124 ? ( 6, 40, 55 ) #
125 : ( 4, 16, 4 );
126 my ( $ramp, $ramp1, $ramp2 ) = $base #
127 ? ( 24, 10, 8 ) #
128 : ( 8, 23.18181818, 46.36363636 );
129
130 my @result = &xterm16;
131 my $o = 16;
132
133 my $red;
134 my $green;
135 my $blue;
136 my $gray;
137
138 for ( $red = 0 ; $red < $cube ; $red++ ) {
139 for ( $green = 0 ; $green < $cube ; $green++ ) {
140 for ( $blue = 0 ; $blue < $cube ; $blue++ ) {
141 my %data;
142 $data{R} = ( $red ? ( $red * $cube1 + $cube2 ) : 0 );
143 $data{G} = ( $green ? ( $green * $cube1 + $cube2 ) : 0 );
144 $data{B} = ( $blue ? ( $blue * $cube1 + $cube2 ) : 0 );
145 $data{NAME} = sprintf "cube %d,%d,%d", $red, $green, $blue;
146 $result[ $o++ ] = \%data;
147 }
148 }
149 }
150
151 for ( $gray = 0 ; $gray < $ramp ; $gray++ ) {
152 my $level = ( $gray * $ramp1 ) + $ramp2;
153 my %data;
154 $data{R} = $level;
155 $data{G} = $level;
156 $data{B} = $level;
157 $data{NAME} = sprintf "ramp %d", $gray;
158 $result[ $o++ ] = \%data;
159 }
160
161 return @result;
162 }
163
164 sub xterm88() {
165 return &xtermRGB(0);
166 }
167
168 sub xterm256() {
169 return &xtermRGB(1);
170 }
171
172 sub load_namedRGB($) {
173 my $file = shift;
174 open my $fp, $file || die "cannot open $file";
175 my @data = <$fp>;
176 close $fp;
177 my @result;
178 my $o = 0;
179 for my $i ( 0 .. $#data ) {
180 next if ( $data[$i] =~ /^\s*[[:punct:]]/ );
181
182 $result[ $o++ ] = &lookup( $data[$i] );
183 }
184 return @result;
185 }
186
187 sub distance($$) {
188 my %a = %{ $_[0] };
189 my %b = %{ $_[1] };
190 my $R = $a{R} - $b{R};
191 my $G = $a{G} - $b{G};
192 my $B = $a{B} - $b{B};
193 my $result = sqrt( $R * $R + $G * $G + $B * $B );
194 }
195
196 sub show_distances($$) {
197 my @ref = @{ $_[0] };
198 my @cmp = @{ $_[1] };
199 for my $c ( 0 .. $#cmp ) {
200 my %cmp = %{ $cmp[$c] };
201 my $best = -1;
202 my %best;
203 for my $r ( 0 .. $#ref ) {
204 my %ref = %{ $ref[$r] };
205 my $test = &distance( \%ref, \%cmp );
206 if ( $best < 0 ) {
207 $best = $test;
208 %best = %ref;
209 }
210 elsif ( $best > $test ) {
211 $best = $test;
212 %best = %ref;
213 }
214 }
215 printf "%3d %-25s %5.1f %s\n", $c, $cmp{NAME}, $best, $best{NAME};
216 }
217 }
218
219 @namedRGB = &load_namedRGB($opt_f);
220 printf "%d names from $opt_f\n", $#namedRGB + 1;
221
222 if ( $opt_n <= 16 ) {
223 @xtermRGB = &xterm16;
224 }
225 elsif ( $opt_n <= 88 ) {
226 @xtermRGB = &xterm88;
227 }
228 else {
229 @xtermRGB = &xterm256;
230 }
231 printf "%d names from xterm palette\n", $#xtermRGB + 1;
232
233 &show_distances( \@xtermRGB, \@namedRGB ) if ($opt_i);
234 &show_distances( \@namedRGB, \@xtermRGB ) unless ($opt_i);
235
236 1;