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
37use strict;
38use warnings;
39
40use Getopt::Std;
41
42our $namedRGB = "/etc/X11/rgb.txt";
43our @namedRGB;
44our @xtermRGB;
45
46our ( $opt_f, $opt_i, $opt_n );
47
48sub main::HELP_MESSAGE() {
49    printf STDERR <<EOF
50Usage: $0 [options]\n
51Options:\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)
55EOF
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
65sub 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
76sub 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
98sub 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
120sub 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
164sub xterm88() {
165    return &xtermRGB(0);
166}
167
168sub xterm256() {
169    return &xtermRGB(1);
170}
171
172sub 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
187sub 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
196sub 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);
220printf "%d names from $opt_f\n", $#namedRGB + 1;
221
222if ( $opt_n <= 16 ) {
223    @xtermRGB = &xterm16;
224}
225elsif ( $opt_n <= 88 ) {
226    @xtermRGB = &xterm88;
227}
228else {
229    @xtermRGB = &xterm256;
230}
231printf "%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
2361;
237